Esope source files

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