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    CB215821  24/04/12    21:16:31     11897          
  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.  
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. C
  47. C
  48. C**** We create the table
  49. C
  50.       CALL CRTABL(MTAB)
  51.       CALL ECMM(MTAB,'SOUSTYPE','DOMAINE')
  52.       CALL ECME(MTAB,'PRECONDI',1)
  53. C
  54. C**** We create the QUAF (MAILLAGE + CENTRE + FACE)
  55. C
  56.       CALL ECROBJ('MAILLAGE',MELEME)
  57.       CALL ECRCHA('QUAF')
  58.       CALL PRCHAN
  59.       IF(IERR.NE.0)GOTO 9999
  60.       CALL LIROBJ('MAILLAGE',MELEMQ,1,IRET)
  61.       CALL ECMO(MTAB,'QUAF','MAILLAGE',MELEMQ)
  62. C
  63. C     We change the position of the noeud into the QUAF.
  64. C     Each elements is divided into triangles/tetraedras
  65. C     The centers of interfaces/elements are computed using these
  66. C     elementary meshes
  67. C
  68. C
  69. C******** AXIS
  70. C
  71.       IF(IFOMOD .EQ. 0)THEN
  72.          IF(IDIM.EQ.2)THEN
  73.             CALL KDOM2A(MTAB,MELEMQ)
  74.             IF(IERR.NE.0)GOTO 9999
  75.          ELSE
  76.             WRITE(IOIMP,*) 'Axis-symmetrical in 2D only'
  77.             CALL ERREUR(21)
  78.             GOTO 9999
  79.          ENDIF
  80.       ELSE
  81.          CALL KDOM2(MELEMQ)
  82.          IF(IERR.NE.0)GOTO 9999
  83. C
  84. C******* Now we recreate the 'MAILLAGE'.
  85. C        We also create the 'CENTRE', 'FACE', 'FACEL', 'ELTFA', 'FACEP'
  86. C        'XXVOLUM', 'XXSURFAC', 'XXNORMAF', 'XXDIEMIN'
  87. C
  88.          CALL KDOM10(MTAB)
  89.       ENDIF
  90. C
  91.  9999 RETURN
  92. C
  93.       END
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  

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