Télécharger la plaquette Cast3M


fr en

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