Télécharger la plaquette Cast3M


fr en

Télécharger kdom0.eso

Retour à la liste

Numérotation des lignes : 

kdom0

  1. C KDOM0     SOURCE    CB215821  24/04/12    21:16:31     11897          
  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.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMELEME
  32. C
  33. C**** We create the TABLE DOMAINE or we
  34. C     recover it if it already exists
  35. C
  36.       TYPE='MMODEL'
  37.       CALL LIROBJ(TYPE,MMODEL,1,IRET)
  38.       IF(IERR.NE.0) RETURN
  39. C
  40.       SEGACT MMODEL
  41.       N1=MMODEL.KMODEL(/1)
  42.       DO I1=1,N1,1
  43.          IMODEL=MMODEL.KMODEL(I1)
  44.          SEGACT IMODEL*MOD
  45. C
  46. C********** For the moment no coupling
  47. C
  48.          IF(IMODEL.FORMOD(1).NE.'EULER')THEN
  49.             WRITE(IOIMP,*) 'No coupling in VF'
  50.             CALL ERREUR(21)
  51.             RETURN
  52.          ENDIF
  53.       ENDDO
  54. C
  55. C**** If existing the domain table is hidden into
  56. C     MMODEL.KMODEL(1).INFMOD(2)
  57. C
  58.       IMODEL=MMODEL.KMODEL(N1)
  59.       MTAB=IMODEL.INFMOD(2)
  60. C
  61.       IF(MTAB.EQ.0)THEN
  62. C
  63. C****** We recreate the global mesh
  64. C
  65.          IMODEL=MMODEL.KMODEL(1)
  66.          MELEME=IMODEL.IMAMOD
  67.          SEGACT MELEME
  68.          DO I1=2,N1,1
  69.             IMODEL=MMODEL.KMODEL(I1)
  70.             IPT1=IMODEL.IMAMOD
  71.             SEGACT IPT1
  72.             CALL ECROBJ('MAILLAGE',MELEME)
  73.             CALL ECROBJ('MAILLAGE',IPT1)
  74.             CALL PRFUSE
  75.             CALL LIROBJ('MAILLAGE',IPT2,1,IRET)
  76.             SEGDES MELEME
  77.             SEGDES IPT1
  78.             MELEME=IPT2
  79.          ENDDO
  80. C
  81. C******* Table domaine does not exist
  82. C        We create it
  83. C
  84.          CALL KDOM1(MELEME,MTAB)
  85.          IF(IERR .NE. 0) RETURN
  86. C
  87.          IMODEL=MMODEL.KMODEL(N1)
  88.          IMODEL.INFMOD(2)=MTAB
  89.       ENDIF
  90. C
  91.       DO I1=1,N1,1
  92.          IMODEL=MMODEL.KMODEL(I1)
  93.          SEGDES IMODEL
  94.       ENDDO
  95. C
  96.       SEGDES MMODEL
  97. C
  98. C**** Now the TABLE DOMAINE exists and it is filled
  99. C
  100.       CALL ECROBJ('TABLE',MTAB)
  101.       RETURN
  102.       END
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  

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