Télécharger kdom0.eso

Retour à la liste

Numérotation des lignes :

  1. C KDOM0 SOURCE KK2000 14/04/10 21:15:08 8032
  2. SUBROUTINE KDOM0
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : KDOM0
  9. C
  10. C DESCRIPTION : Modele EULER
  11. C Creation/Lecture et restitution de la table
  12. C domaine
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  15. C
  16. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. INTEGER IRET, N1, I1, MTAB
  25. CHARACTER*8 TYPE
  26. C
  27. -INC SMMODEL
  28. -INC CCOPTIO
  29. -INC SMELEME
  30. C
  31. C**** We create the TABLE DOMAINE or we
  32. C recover it if it already exists
  33. C
  34. TYPE='MMODEL'
  35. CALL LIROBJ(TYPE,MMODEL,1,IRET)
  36. IF(IERR.NE.0) RETURN
  37. C
  38. SEGACT MMODEL
  39. N1=MMODEL.KMODEL(/1)
  40. DO I1=1,N1,1
  41. IMODEL=MMODEL.KMODEL(I1)
  42. SEGACT IMODEL*MOD
  43. C
  44. C********** For the moment no coupling
  45. C
  46. IF(IMODEL.FORMOD(1).NE.'EULER')THEN
  47. WRITE(IOIMP,*) 'No coupling in VF'
  48. CALL ERREUR(21)
  49. RETURN
  50. ENDIF
  51. ENDDO
  52. C
  53. C**** If existing the domain table is hidden into
  54. C MMODEL.KMODEL(1).INFMOD(2)
  55. C
  56. IMODEL=MMODEL.KMODEL(N1)
  57. MTAB=IMODEL.INFMOD(2)
  58. C
  59. IF(MTAB.EQ.0)THEN
  60. C
  61. C****** We recreate the global mesh
  62. C
  63. IMODEL=MMODEL.KMODEL(1)
  64. MELEME=IMODEL.IMAMOD
  65. SEGACT MELEME
  66. DO I1=2,N1,1
  67. IMODEL=MMODEL.KMODEL(I1)
  68. IPT1=IMODEL.IMAMOD
  69. SEGACT IPT1
  70. CALL ECROBJ('MAILLAGE',MELEME)
  71. CALL ECROBJ('MAILLAGE',IPT1)
  72. CALL PRFUSE
  73. CALL LIROBJ('MAILLAGE',IPT2,1,IRET)
  74. SEGDES MELEME
  75. SEGDES IPT1
  76. MELEME=IPT2
  77. ENDDO
  78. C
  79. C******* Table domaine does not exist
  80. C We create it
  81. C
  82. CALL KDOM1(MELEME,MTAB)
  83. IF(IERR .NE. 0) RETURN
  84. C
  85. IMODEL=MMODEL.KMODEL(N1)
  86. IMODEL.INFMOD(2)=MTAB
  87. ENDIF
  88. C
  89. DO I1=1,N1,1
  90. IMODEL=MMODEL.KMODEL(I1)
  91. SEGDES IMODEL
  92. ENDDO
  93. C
  94. SEGDES MMODEL
  95. C
  96. C**** Now the TABLE DOMAINE exists and it is filled
  97. C
  98. CALL ECROBJ('TABLE',MTAB)
  99. RETURN
  100. END
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  

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