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.  
  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.  

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