Télécharger kdom2a.eso

Retour à la liste

Numérotation des lignes :

  1. C KDOM2A SOURCE CHAT 05/01/13 00:53:50 5004
  2. SUBROUTINE KDOM2A(MTAB,MELEMQ)
  3. C
  4. C************************************************************************
  5. C
  6. C PROJET : CASTEM 2000
  7. C
  8. C NOM : KDOM2A
  9. C
  10. C DESCRIPTION : Subroutine called by KDOM1
  11. C Axial-symmetric case
  12. C
  13. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  14. C
  15. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  16. C
  17. C************************************************************************
  18. C
  19. C E/S : MTAB : domaine table
  20. C MELEMQ : QUAF mesh
  21. C
  22. C************************************************************************
  23. C
  24. C Created the 24/02/04
  25. C
  26. C
  27. C**** Variables de COOPTIO
  28. C
  29. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  30. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  31. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  32. C & ,IECHO, IIMPI, IOSPI
  33. C & ,IDIM, IFICLE, IPREFI
  34. C & ,MCOORD
  35. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  36. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  37. C & ,NORINC,NORVAL,NORIND,NORVAD
  38. C & ,NUCROU, IPSAUV, IREFOR, ISAFOR
  39. C
  40. IMPLICIT INTEGER(I-N)
  41. INTEGER MTAB, MELEMQ, NBSOUS, ISOUS
  42. LOGICAL LOSEG3, LOTRI7, LOQUA9
  43. C
  44. -INC CCOPTIO
  45. -INC SMELEME
  46. C
  47. C Elements allowed are SEG3, TRI7, QUA9
  48. C ITYPEL 3 7 11
  49. C They can be referred just once
  50. C We define LISTSO s.t.
  51. C
  52. LOSEG3=.FALSE.
  53. LOTRI7=.FALSE.
  54. LOQUA9=.FALSE.
  55. C
  56. MELEME=MELEMQ
  57. SEGACT MELEME
  58. NBSOUS=MELEME.LISOUS(/1)
  59. IF(NBSOUS .EQ. 0) NBSOUS=1
  60. DO ISOUS=1,NBSOUS,1
  61. IF(NBSOUS .NE. 1)THEN
  62. IPT1=MELEME.LISOUS(ISOUS)
  63. SEGACT IPT1
  64. ELSE
  65. IPT1=MELEME
  66. ENDIF
  67. C
  68. IF(IPT1.ITYPEL .EQ. 3)THEN
  69. IF(NBSOUS .NE. 1)THEN
  70. C SEG3 with TRI7 or QUA9 -> Error
  71. C 2 SEG3 in the same mesh -> Error
  72. C Note that in that case IPT1=MELEMQ
  73. WRITE(IOIMP,*) 'Subroutine kdom2a'
  74. WRITE(IOIMP,*) 'Mesh type not recognized'
  75. CALL ERREUR(5)
  76. ENDIF
  77. LOSEG3=.TRUE.
  78. C
  79. C********** SEG3
  80. C
  81. C We compute
  82. C MTAB . 'XXVOLUM'
  83. C MTAB . 'CENTRE'
  84. C and we change the positions of the central points in MELEMQ
  85. C
  86. CALL KDOM3A(MTAB,IPT1)
  87. IF(IERR.NE.0)GOTO 9999
  88. C
  89. ELSEIF(IPT1.ITYPEL .EQ. 7)THEN
  90. C
  91. C********** TRI7
  92. C
  93. IF(LOTRI7)THEN
  94. C Elt already referred
  95. WRITE(IOIMP,*) 'Subroutine kdom2a'
  96. WRITE(IOIMP,*) 'Mesh type not recognized'
  97. CALL ERREUR(5)
  98. GOTO 9999
  99. ENDIF
  100. LOTRI7=.TRUE.
  101. C
  102. ELSEIF(IPT1.ITYPEL .EQ. 11)THEN
  103. C
  104. C********** QUA9
  105. C
  106. IF(LOQUA9)THEN
  107. C Elt already referred
  108. WRITE(IOIMP,*) 'Subroutine kdom2a'
  109. WRITE(IOIMP,*) 'Mesh type not recognized'
  110. CALL ERREUR(5)
  111. GOTO 9999
  112. ENDIF
  113. LOQUA9=.TRUE.
  114. ELSE
  115. C Elt already referred
  116. WRITE(IOIMP,*) 'Subroutine kdom2a'
  117. WRITE(IOIMP,*) 'Mesh type not recognized'
  118. CALL ERREUR(5)
  119. GOTO 9999
  120. ENDIF
  121. SEGDES IPT1
  122. ENDDO
  123. C
  124. IF(NBSOUS .NE. 1) SEGDES MELEME
  125. C
  126. C**** 2 cases:
  127. C SEG3 -> Everything is done
  128. C TRI7/QUA9 -> We have checked that the meshes
  129. C is not bizarre
  130. C Everything is to do
  131. C
  132. IF(.NOT. LOSEG3)THEN
  133. CALL KDOM4A(MTAB,MELEMQ)
  134. IF(IERR .NE. 0)GOTO 9999
  135. ENDIF
  136. C
  137. 9999 RETURN
  138. C
  139. END
  140.  
  141.  
  142.  
  143.  

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