Esope source files

   1 : C KDOM1     SOURCE    CHAT      11/03/16    21:26:07     6902           
   2 :       SUBROUTINE KDOM1(MELEME,MTAB)
   3 : C
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  KDOM1
   9 : C
  10 : C DESCRIPTION       :  Lecture du modele EULER
  11 : C                      Restitution de la table domaine remplie
  12 : C     
  13 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  14 : C      
  15 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF                        
  16 : C
  17 : C************************************************************************
  18 : C
  19 : C E/S               : MTAB   : domaine table
  20 : C                     MELEMQ : QUAF mesh
  21 : C
  22 : C************************************************************************
  23 : C
  24 : C Created the 24/02/04
  25 : C
  26 : C
  27 : C**** Variables de COOPTIO
  28 : C
  29 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  30 : C     &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  31 : C     &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  32 : C     &     ,IECHO,   IIMPI,  IOSPI
  33 : C     &     ,IDIM,    IFICLE, IPREFI     
  34 : C     &     ,MCOORD
  35 : C     &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  36 : C     &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  37 : C     &     ,NORINC,NORVAL,NORIND,NORVAD
  38 : C     &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  39 : CC
  40 :       IMPLICIT INTEGER(I-N)
  41 :       INTEGER MTAB, MELEME, IRET, MELEMQ
  42 : -INC SMMODEL
  43 : -INC CCOPTIO
  44 : C
  45 : C
  46 : C**** We create the table
  47 : C
  47 :       CALL CRTABL(MTAB)
  47 :       CALL ECMM(MTAB,'SOUSTYPE','DOMAINE')
  47 :       CALL ECME(MTAB,'PRECONDI',1)
  48 : C
  49 : C**** We create the QUAF (MAILLAGE + CENTRE + FACE)
  50 : C     
  50 :       CALL ECROBJ('MAILLAGE',MELEME)
  50 :       CALL ECRCHA('QUAF')
  50 :       CALL PRCHAN
  51 :       IF(IERR.NE.0)GOTO 9999
  51 :       CALL LIROBJ('MAILLAGE',MELEMQ,1,IRET)
  51 :       CALL ECMO(MTAB,'QUAF','MAILLAGE',MELEMQ)
  52 : C
  53 : C     We change the position of the noeud into the QUAF.
  54 : C     Each elements is divided into triangles/tetraedras
  55 : C     The centers of interfaces/elements are computed using these
  56 : C     elementary meshes
  57 : C
  58 : C
  59 : C******** AXIS
  60 : C
  61 :       IF(IFOMOD .EQ. 0)THEN
  62 :          IF(IDIM.EQ.2)THEN
  62 :             CALL KDOM2A(MTAB,MELEMQ) 
  63 :             IF(IERR.NE.0)GOTO 9999
  64 :          ELSE
  65 :             WRITE(IOIMP,*) 'Axis-symmetrical in 2D only'
  65 :             CALL ERREUR(21)
  66 :             GOTO 9999
  67 :          ENDIF
  68 :       ELSE
  68 :          CALL KDOM2(MELEMQ)
  69 :          IF(IERR.NE.0)GOTO 9999
  70 : C
  71 : C******* Now we recreate the 'MAILLAGE'.
  72 : C        We also create the 'CENTRE', 'FACE', 'FACEL', 'ELTFA', 'FACEP'
  73 : C        'XXVOLUM', 'XXSURFAC', 'XXNORMAF', 'XXDIEMIN'
  74 : C
  74 :          CALL KDOM10(MTAB)
  75 :       ENDIF
  76 : C
  77 :  9999 RETURN
  78 : C     
  79 :       END
  80 :  
  81 :  
  82 :  
  83 :  
  84 :  
  85 :