Télécharger kdom1.eso

Retour à la liste

Numérotation des lignes :

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

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