Télécharger kdom2a.eso

Retour à la liste

Numérotation des lignes :

kdom2a
  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.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMELEME
  48. C
  49. C Elements allowed are SEG3, TRI7, QUA9
  50. C ITYPEL 3 7 11
  51. C They can be referred just once
  52. C We define LISTSO s.t.
  53. C
  54. LOSEG3=.FALSE.
  55. LOTRI7=.FALSE.
  56. LOQUA9=.FALSE.
  57. C
  58. MELEME=MELEMQ
  59. SEGACT MELEME
  60. NBSOUS=MELEME.LISOUS(/1)
  61. IF(NBSOUS .EQ. 0) NBSOUS=1
  62. DO ISOUS=1,NBSOUS,1
  63. IF(NBSOUS .NE. 1)THEN
  64. IPT1=MELEME.LISOUS(ISOUS)
  65. SEGACT IPT1
  66. ELSE
  67. IPT1=MELEME
  68. ENDIF
  69. C
  70. IF(IPT1.ITYPEL .EQ. 3)THEN
  71. IF(NBSOUS .NE. 1)THEN
  72. C SEG3 with TRI7 or QUA9 -> Error
  73. C 2 SEG3 in the same mesh -> Error
  74. C Note that in that case IPT1=MELEMQ
  75. WRITE(IOIMP,*) 'Subroutine kdom2a'
  76. WRITE(IOIMP,*) 'Mesh type not recognized'
  77. CALL ERREUR(5)
  78. ENDIF
  79. LOSEG3=.TRUE.
  80. C
  81. C********** SEG3
  82. C
  83. C We compute
  84. C MTAB . 'XXVOLUM'
  85. C MTAB . 'CENTRE'
  86. C and we change the positions of the central points in MELEMQ
  87. C
  88. CALL KDOM3A(MTAB,IPT1)
  89. IF(IERR.NE.0)GOTO 9999
  90. C
  91. ELSEIF(IPT1.ITYPEL .EQ. 7)THEN
  92. C
  93. C********** TRI7
  94. C
  95. IF(LOTRI7)THEN
  96. C Elt already referred
  97. WRITE(IOIMP,*) 'Subroutine kdom2a'
  98. WRITE(IOIMP,*) 'Mesh type not recognized'
  99. CALL ERREUR(5)
  100. GOTO 9999
  101. ENDIF
  102. LOTRI7=.TRUE.
  103. C
  104. ELSEIF(IPT1.ITYPEL .EQ. 11)THEN
  105. C
  106. C********** QUA9
  107. C
  108. IF(LOQUA9)THEN
  109. C Elt already referred
  110. WRITE(IOIMP,*) 'Subroutine kdom2a'
  111. WRITE(IOIMP,*) 'Mesh type not recognized'
  112. CALL ERREUR(5)
  113. GOTO 9999
  114. ENDIF
  115. LOQUA9=.TRUE.
  116. ELSE
  117. C Elt already referred
  118. WRITE(IOIMP,*) 'Subroutine kdom2a'
  119. WRITE(IOIMP,*) 'Mesh type not recognized'
  120. CALL ERREUR(5)
  121. GOTO 9999
  122. ENDIF
  123. SEGDES IPT1
  124. ENDDO
  125. C
  126. IF(NBSOUS .NE. 1) SEGDES MELEME
  127. C
  128. C**** 2 cases:
  129. C SEG3 -> Everything is done
  130. C TRI7/QUA9 -> We have checked that the meshes
  131. C is not bizarre
  132. C Everything is to do
  133. C
  134. IF(.NOT. LOSEG3)THEN
  135. CALL KDOM4A(MTAB,MELEMQ)
  136. IF(IERR .NE. 0)GOTO 9999
  137. ENDIF
  138. C
  139. 9999 RETURN
  140. C
  141. END
  142.  
  143.  
  144.  
  145.  

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