Esope source files

   1 : C KDME      SOURCE    CHAT      05/01/13    00:53:20     5004           
   2 :       SUBROUTINE KDME
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*************************************************************************
   6 : C
   7 : C     OBJET   : Cree un CHAMPOINT CENTRE contenant le diametre max des
   8 : C               éléments du domaine
   9 : C
  10 : C     SYNTAXE : CHPC = KDME OBJDOM ;
  11 : C
  12 : C                      OBJDOM : TABLE de SOUSTYPE DOMAINE
  13 : C
  14 : C*************************************************************************
  15 : -INC CCREEL
  16 : -INC CCOPTIO
  17 : -INC SMELEME
  18 : -INC SMCOORD
  19 : -INC SMCHPOI
  20 : 
  21 : *      PARAMETER (XPETI2=XPETIT**2)
  22 :       PARAMETER (NTB=1)
  23 :       CHARACTER*8 LTAB(NTB),TYPE,TYPC
  24 :       DIMENSION KTAB(NTB)
  25 :       DATA LTAB/'DOMAINE '/
  26 : C***
  27 :       XPETI2 = XPETIT
  28 :       NTO=NTB
  28 :       CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  29 :       IF(IRET.EQ.0)RETURN
  30 :       MTABD=KTAB(1)
  31 : 
  32 :       TYPE=' '
  32 :       CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
  33 :       IF(TYPE.NE.'MAILLAGE')GO TO 90
  34 :       NC=1
  35 :       TYPE='CENTRE'
  35 :       CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI)
  36 : C     In LICHT -> SEGACT MPOVAL*MOD
  36 :       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  37 : 
  38 :       TYPE=' '
  38 :       CALL ACMO(MTABD,'MAILLAGE',TYPE,MELEME)
  39 :       IF(TYPE.NE.'MAILLAGE')GO TO 90
  40 :       SEGACT MELEME
  41 : 
  42 :       NBSOUS=LISOUS(/1)
  43 :       IF(NBSOUS.EQ.0)NBSOUS=1
  44 : 
  45 :       NELT=0
  46 :       DO 1 L=1,NBSOUS
  47 :          IF(NBSOUS.EQ.1)THEN
  48 :             IPT1=MELEME
  49 :          ELSE
  50 :             IPT1=LISOUS(L)
  51 :             SEGACT IPT1
  52 :          ENDIF
  53 :          NP=IPT1.NUM(/1)
  54 :          NEL=IPT1.NUM(/2)
  55 : 
  56 :          DO 10 K=1,NEL
  57 :             NELT=NELT+1
  58 : 
  59 : C             CALCUL DU DIAMETRE MAX
  60 : 
  61 :             XMA2=0.D0
  62 :             DO 321 I=1,NP-1
  63 :                IPI=IPT1.NUM(I,K)
  64 :                DO 322 J=I+1,NP
  65 :                   IPJ=IPT1.NUM(J,K)
  66 :                   XM2=0.D0
  67 :                   DO 323 N=1,IDIM
  68 :                      XM2=XM2+(XCOOR((IPI-1)*(IDIM+1)+N)
  69 :      $                       -XCOOR((IPJ-1)*(IDIM+1)+N))**2
  70 :  323              CONTINUE
  71 :                   XMA2=MAX(XMA2,XM2)
  72 :  322           CONTINUE
  73 :  321        CONTINUE
  74 : C
  75 : *            IF(XMA2.LT.XPETI2) WRITE(6,*)
  76 : *     $           'kdme.eso : un element est peut-etre degenere'
  77 : 
  78 :             VPOCHA(NELT,1)=SQRT(XMA2)
  79 :  10      CONTINUE
  80 :          SEGDES IPT1
  81 :  1    CONTINUE
  82 :       IF(NBSOUS.NE.1) SEGDES MELEME
  83 :       SEGDES MPOVAL
  84 : C
  84 :       CALL ECROBJ('CHPOINT ',MCHPOI)
  85 : 
  86 :       RETURN
  87 : 
  88 :  90   CONTINUE
  89 : *      WRITE(6,*)' Interruption anormale dans kdme.eso'
  90 :       RETURN
  91 :  1001 FORMAT(20(1X,I5))
  92 :       END
  93 : 
  94 : 
  95 :  
  96 :