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    CB215821  20/11/25    13:31:05     10792          
  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. C**** Variables de COOPTIO
  32. C
  33. C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  34. C     &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  35. C     &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  36. C     &     ,IECHO,   IIMPI,  IOSPI
  37. C     &     ,IDIM,    IFICLE, IPREFI
  38. CC     &     ,MCOORD
  39. C     &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  40. C     &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  41. C     &     ,NORINC,NORVAL,NORIND,NORVAD
  42. C     &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  43. C
  44. C
  45.       IMPLICIT INTEGER(I-N)
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. -INC SMCOORD
  50. -INC SMELEME
  51. -INC SMLMOTS
  52. -INC SMCHPOI
  53.       INTEGER MTAB, NBEL,NBELEM, NBSOUS, NBREF, NBNN, IELEM, JGN, JGM
  54.      &     , NN1, NN2, NN3, IEL, IGEOM
  55.       POINTEUR MELMAI.MELEME, MELCEN.MELEME
  56.       REAL*8 X1, Y1, X3, Y3, VOLU, X2, Y2
  57.       CHARACTER*8 TYPI
  58. C
  59.       NBEL=IPT1.NUM(/2)
  60. C
  61. C**** 'MAILLAGE'
  62. C     'CENTRE' (with bad positions)
  63. C
  64. C     Initialisation
  65. C
  66.       NBELEM=NBEL
  67.       NBSOUS=0
  68.       NBREF=0
  69.       NBNN=2
  70.       SEGINI MELMAI
  71.       MELMAI.ITYPEL=2
  72. C
  73.       NBELEM=NBEL
  74.       NBNN=1
  75.       NBSOUS=0
  76.       NBREF=0
  77.       SEGINI MELCEN
  78.       MELCEN.ITYPEL=1
  79. C
  80. C**** Filling
  81. C
  82.       DO IELEM=1,NBELEM,1
  83.          MELMAI.NUM(1,IELEM)=IPT1.NUM(1,IELEM)
  84.          MELMAI.NUM(2,IELEM)=IPT1.NUM(3,IELEM)
  85.          MELMAI.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
  86.          MELCEN.NUM(1,IELEM)=IPT1.NUM(2,IELEM)
  87.          MELCEN.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
  88.       ENDDO
  89.       CALL ECMO(MTAB,'MAILLAGE','MAILLAGE',MELMAI)
  90.       CALL ECMO(MTAB,'CENTRE','MAILLAGE',MELCEN)
  91.       SEGDES MELCEN
  92.       SEGDES MELMAI
  93. C
  94. C**** Volume
  95. C
  96.       TYPI='CENTRE  '
  97.       JGN=4
  98.       JGM=1
  99.       SEGINI MLMOTS
  100.       MLMOTS.MOTS(1)='SCAL'
  101.       CALL KRCHP1(TYPI,MELCEN,MCHPOI,MLMOTS)
  102.       IF(IERR.NE.0) GOTO 9999
  103.       SEGSUP MLMOTS
  104.       CALL ECMO(MTAB,'XXVOLUM','CHPOINT',MCHPOI)
  105.       IF(IERR.NE.0) GOTO 9999
  106.       CALL LICHT(MCHPOI,MPOVAL,TYPI,IGEOM)
  107.       IF(IERR.NE.0) GOTO 9999
  108. C     SEGACT MPOVAL
  109. C
  110. C
  111.       DO IEL=1,NBEL,1
  112. C
  113.          NN1=IPT1.NUM(1,IEL)
  114.          NN2=IPT1.NUM(2,IEL)
  115.          NN3=IPT1.NUM(3,IEL)
  116.          X1=XCOOR((NN1-1)*(IDIM+1)+1)
  117.          Y1=XCOOR((NN1-1)*(IDIM+1)+2)
  118.          X3=XCOOR((NN3-1)*(IDIM+1)+1)
  119.          Y3=XCOOR((NN3-1)*(IDIM+1)+2)
  120. C
  121.          CALL KDOM3B(X1,Y1,X3,Y3,VOLU,X2,Y2)
  122. C
  123.          MPOVAL.VPOCHA(IEL,1)=VOLU
  124. C
  125. C
  126.          XCOOR((NN2-1)*(IDIM+1)+1)=X2
  127.          XCOOR((NN2-1)*(IDIM+1)+2)=Y2
  128. C
  129.       ENDDO
  130. C
  131.       SEGDES MPOVAL
  132. C
  133.  9999 RETURN
  134. C
  135.       END
  136.  
  137.  
  138.  
  139.  
  140.  

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