Télécharger la plaquette Cast3M


fr en

Télécharger kdom1.eso

Retour à la liste

Numérotation des lignes : 

kdom1

  1. C KDOM1     SOURCE    OF166741  24/12/13    21:16:00     12097          
  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.       IMPLICIT INTEGER(I-N)
  27.  
  28.       INTEGER MTAB, MELEME, IRET, MELEMQ
  29. -INC SMMODEL
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. C
  34. C
  35. C**** We create the table
  36. C
  37.       CALL CRTABL(MTAB)
  38.       CALL ECMM(MTAB,'SOUSTYPE','DOMAINE')
  39.       CALL ECME(MTAB,'PRECONDI',1)
  40. C
  41. C**** We create the QUAF (MAILLAGE + CENTRE + FACE)
  42. C
  43.       CALL ECROBJ('MAILLAGE',MELEME)
  44.       CALL ECRCHA('QUAF')
  45.       CALL PRCHAN
  46.       IF(IERR.NE.0)GOTO 9999
  47.       CALL LIROBJ('MAILLAGE',MELEMQ,1,IRET)
  48.       CALL ECMO(MTAB,'QUAF','MAILLAGE',MELEMQ)
  49. C
  50. C     We change the position of the noeud into the QUAF.
  51. C     Each elements is divided into triangles/tetraedras
  52. C     The centers of interfaces/elements are computed using these
  53. C     elementary meshes
  54. C
  55. C
  56. C******** AXIS
  57. C
  58.       IF(IFOMOD .EQ. 0)THEN
  59.          IF(IDIM.EQ.2)THEN
  60.             CALL KDOM2A(MTAB,MELEMQ)
  61.             IF(IERR.NE.0)GOTO 9999
  62.          ELSE
  63.             WRITE(IOIMP,*) 'Axis-symmetrical in 2D only'
  64.             CALL ERREUR(21)
  65.             GOTO 9999
  66.          ENDIF
  67.       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
  75.          CALL KDOM10(MTAB)
  76.       ENDIF
  77. C
  78.  9999 RETURN
  79. C
  80.       END
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales