Télécharger kdom3a.eso

Retour à la liste

Numérotation des lignes :

  1. C KDOM3A SOURCE CHAT 05/01/13 00:54:00 5004
  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. -INC CCOPTIO
  47. -INC SMCOORD
  48. -INC SMELEME
  49. -INC SMLMOTS
  50. -INC SMCHPOI
  51. INTEGER MTAB, NBEL,NBELEM, NBSOUS, NBREF, NBNN, IELEM, JGN, JGM
  52. & , NN1, NN2, NN3, IEL, IGEOM
  53. POINTEUR MELMAI.MELEME, MELCEN.MELEME
  54. REAL*8 X1, Y1, X3, Y3, VOLU, X2, Y2
  55. CHARACTER*8 TYPI
  56. C
  57. NBEL=IPT1.NUM(/2)
  58. C
  59. C**** 'MAILLAGE'
  60. C 'CENTRE' (with bad positions)
  61. C
  62. C Initialisation
  63. C
  64. NBELEM=NBEL
  65. NBSOUS=0
  66. NBREF=0
  67. NBNN=2
  68. SEGINI MELMAI
  69. MELMAI.ITYPEL=2
  70. C
  71. NBELEM=NBEL
  72. NBNN=1
  73. NBSOUS=0
  74. NBREF=0
  75. SEGINI MELCEN
  76. MELCEN.ITYPEL=1
  77. C
  78. C**** Filling
  79. C
  80. DO IELEM=1,NBELEM,1
  81. MELMAI.NUM(1,IELEM)=IPT1.NUM(1,IELEM)
  82. MELMAI.NUM(2,IELEM)=IPT1.NUM(3,IELEM)
  83. MELMAI.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
  84. MELCEN.NUM(1,IELEM)=IPT1.NUM(2,IELEM)
  85. MELCEN.ICOLOR(IELEM)=IPT1.ICOLOR(IELEM)
  86. ENDDO
  87. CALL ECMO(MTAB,'MAILLAGE','MAILLAGE',MELMAI)
  88. CALL ECMO(MTAB,'CENTRE','MAILLAGE',MELCEN)
  89. SEGDES MELCEN
  90. SEGDES MELMAI
  91. C
  92. C**** Volume
  93. C
  94. TYPI='CENTRE '
  95. JGN=4
  96. JGM=1
  97. SEGINI MLMOTS
  98. MLMOTS.MOTS(1)='SCAL'
  99. CALL KRCHP1(TYPI,MELCEN,MCHPOI,MLMOTS)
  100. IF(IERR.NE.0) GOTO 9999
  101. SEGSUP MLMOTS
  102. CALL ECMO(MTAB,'XXVOLUM','CHPOINT',MCHPOI)
  103. IF(IERR.NE.0) GOTO 9999
  104. CALL LICHT(MCHPOI,MPOVAL,TYPI,IGEOM)
  105. IF(IERR.NE.0) GOTO 9999
  106. C SEGACT MPOVAL
  107. C
  108. C
  109. DO IEL=1,NBEL,1
  110. C
  111. NN1=IPT1.NUM(1,IEL)
  112. NN2=IPT1.NUM(2,IEL)
  113. NN3=IPT1.NUM(3,IEL)
  114. X1=XCOOR((NN1-1)*(IDIM+1)+1)
  115. Y1=XCOOR((NN1-1)*(IDIM+1)+2)
  116. X3=XCOOR((NN3-1)*(IDIM+1)+1)
  117. Y3=XCOOR((NN3-1)*(IDIM+1)+2)
  118. C
  119. CALL KDOM3B(X1,Y1,X3,Y3,VOLU,X2,Y2)
  120. C
  121. MPOVAL.VPOCHA(IEL,1)=VOLU
  122. C
  123. C
  124. XCOOR((NN2-1)*(IDIM+1)+1)=X2
  125. XCOOR((NN2-1)*(IDIM+1)+2)=Y2
  126. C
  127. ENDDO
  128. C
  129. SEGDES MPOVAL
  130. C
  131. 9999 RETURN
  132. C
  133. END
  134.  
  135.  
  136.  
  137.  

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