Télécharger la plaquette Cast3M


fr en

Télécharger kdom3a.eso

Retour à la liste

Numérotation des lignes : 

kdom3a

  1. C KDOM3A    SOURCE    OF166741  24/12/13    21:16:02     12097          
  2.       SUBROUTINE KDOM3A(MTAB,IPT1)
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET            :  CASTEM 2000
  7. C
  8. C NOM               :  KDOM3A
  9. C
  10. C DESCRIPTION       :  Subroutine called by KDOM2A
  11. C                      Axial-symmetric case, SEG3
  12. C                      We compute
  13. C                      MTAB . 'XXVOLUM'
  14. C                      MTAB . 'CENTRE'
  15. C                      and we change the position for the central points
  16. C                      of MELEMQ
  17. C
  18. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  21. C
  22. C************************************************************************
  23. C
  24. C INPUT/OUTPUT      : MTAB   : domaine table
  25. C                     IPT1   : elementary QUAF mesh of SEG3
  26. C
  27. C************************************************************************
  28. C
  29. C Created the 24/02/04
  30. C
  31.       IMPLICIT INTEGER(I-N)
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMCOORD
  36. -INC SMELEME
  37. -INC SMLMOTS
  38. -INC SMCHPOI
  39.       INTEGER MTAB, NBEL,NBELEM, NBSOUS, NBREF, NBNN, IELEM, JGN, JGM
  40.      &     , NN1, NN2, NN3, IEL, IGEOM
  41.       POINTEUR MELMAI.MELEME, MELCEN.MELEME
  42.       REAL*8 X1, Y1, X3, Y3, VOLU, X2, Y2
  43.       CHARACTER*8 TYPI
  44. C
  45.       NBEL=IPT1.NUM(/2)
  46. C
  47. C**** 'MAILLAGE'
  48. C     'CENTRE' (with bad positions)
  49. C
  50. C     Initialisation
  51. C
  52.       NBELEM=NBEL
  53.       NBSOUS=0
  54.       NBREF=0
  55.       NBNN=2
  56.       SEGINI MELMAI
  57.       MELMAI.ITYPEL=2
  58. C
  59.       NBELEM=NBEL
  60.       NBNN=1
  61.       NBSOUS=0
  62.       NBREF=0
  63.       SEGINI MELCEN
  64.       MELCEN.ITYPEL=1
  65. C
  66. C**** Filling
  67. C
  68.       DO IELEM=1,NBELEM,1
  69.          MELMAI.NUM(1,IELEM)=IPT1.NUM(1,IELEM)
  70.          MELMAI.NUM(2,IELEM)=IPT1.NUM(3,IELEM)
  71.          MELMAI.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
  72.          MELCEN.NUM(1,IELEM)=IPT1.NUM(2,IELEM)
  73.          MELCEN.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
  74.       ENDDO
  75.       CALL ECMO(MTAB,'MAILLAGE','MAILLAGE',MELMAI)
  76.       CALL ECMO(MTAB,'CENTRE','MAILLAGE',MELCEN)
  77.       SEGDES MELCEN
  78.       SEGDES MELMAI
  79. C
  80. C**** Volume
  81. C
  82.       TYPI='CENTRE  '
  83.       JGN=4
  84.       JGM=1
  85.       SEGINI MLMOTS
  86.       MLMOTS.MOTS(1)='SCAL'
  87.       CALL KRCHP1(TYPI,MELCEN,MCHPOI,MLMOTS)
  88.       IF(IERR.NE.0) GOTO 9999
  89.       SEGSUP MLMOTS
  90.       CALL ECMO(MTAB,'XXVOLUM','CHPOINT',MCHPOI)
  91.       IF(IERR.NE.0) GOTO 9999
  92.       CALL LICHT(MCHPOI,MPOVAL,TYPI,IGEOM)
  93.       IF(IERR.NE.0) GOTO 9999
  94. C     SEGACT MPOVAL
  95. C
  96. C
  97.       DO IEL=1,NBEL,1
  98. C
  99.          NN1=IPT1.NUM(1,IEL)
  100.          NN2=IPT1.NUM(2,IEL)
  101.          NN3=IPT1.NUM(3,IEL)
  102.          X1=XCOOR((NN1-1)*(IDIM+1)+1)
  103.          Y1=XCOOR((NN1-1)*(IDIM+1)+2)
  104.          X3=XCOOR((NN3-1)*(IDIM+1)+1)
  105.          Y3=XCOOR((NN3-1)*(IDIM+1)+2)
  106. C
  107.          CALL KDOM3B(X1,Y1,X3,Y3,VOLU,X2,Y2)
  108. C
  109.          MPOVAL.VPOCHA(IEL,1)=VOLU
  110. C
  111. C
  112.          XCOOR((NN2-1)*(IDIM+1)+1)=X2
  113.          XCOOR((NN2-1)*(IDIM+1)+2)=Y2
  114. C
  115.       ENDDO
  116. C
  117.       SEGDES MPOVAL
  118. C
  119.  9999 RETURN
  120. C
  121.       END
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  

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