Esope source files

   1 : C KDMI      SOURCE    PV        09/03/12    21:26:04     6325           
   2 :       SUBROUTINE KDMI
   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 min des
   8 : C               éléments du domaine
   9 : C
  10 : C     SYNTAXE : CHPC = KDMI OBJDOM ;
  11 : C
  12 : C                      OBJDOM : TABLE de SOUSTYPE DOMAINE
  13 : C
  14 : C*************************************************************************
  15 : -INC CCREEL
  16 : -INC CCOPTIO
  17 : -INC SMELEME
  18 :       POINTEUR MELEMC.MELEME, MELEMF.MELEME
  19 : -INC SMCOORD
  20 : -INC SMCHPOI
  21 : -INC SMLENTI
  22 : -INC SMCHAML
  23 : *      PARAMETER (XPETI2=XPETIT**2)
  24 :       PARAMETER (NTB=1)
  25 :       CHARACTER*8 LTAB(NTB),TYPE,TYPC
  26 :       DIMENSION KTAB(NTB)
  27 :       DATA LTAB/'DOMAINE '/
  28 : C***
  29 :       NTO=NTB
  29 :       CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  30 :       IF(IRET.EQ.0)RETURN
  31 :       MTABD=KTAB(1)
  32 : 
  33 :       TYPE=' '
  33 :       CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
  34 :       IF(TYPE.NE.'MAILLAGE')GO TO 90
  34 :       CALL ACMO(MTABD,'FACEL',TYPE,MELEMF)
  35 :       IF(TYPE.NE.'MAILLAGE')GO TO 90
  36 :       TYPE=' '
  36 :       CALL ACMO(MTABD,'XXNORMAF',TYPE,MCHPO1)
  37 :       IF (TYPE.NE.'CHPOINT ') THEN
  37 :       CALL KNRF(MTABD,MCHELM,MCHPO1,MCHPO2)
  38 :       SEGSUP MCHELM
  39 :       SEGSUP MCHPO2
  40 :       ENDIF
  41 :       NC=1
  42 :       TYPE='CENTRE'
  42 :       CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI)
  43 : C     In LICHT -> SEGACT MPOVAL*MOD
  43 :       CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  43 :       CALL LICHT(MCHPO1,MPOVA1,TYPC,IGEOM)
  44 :       TYPE=' '
  45 :       IPT1=MELEMF
  46 :       SEGACT IPT1
  47 :       IPT2=MELEMC
  48 :       SEGACT IPT2
  48 :       CALL KRIPAD(IPT2,MLENTI)
  49 :       SEGACT MLENTI
  50 :       NF=IPT1.NUM(/2)
  51 :       NEL=IPT2.NUM(/2)
  52 :       DO 5 K=1,NEL
  53 : C#          VPOCHA(K,1)=XGRAND**2
  54 :           VPOCHA(K,1)=XGRAND
  55 :  5    CONTINUE    
  56 :       DO 10 K=1,NF
  57 : C             CALCUL DU DIAMETRE MIN
  58 : C         PRODUIT SCALAIRE DE LA NORMALE A LA FACE ET DU VECTEUR
  59 : C         CENTRE/FACE
  60 :           IPI=IPT1.NUM(2,K)
  61 : C  Point gauche
  62 :           IPC=IPT1.NUM(1,K)
  63 :           XM2=0.D0
  64 :           DO 325 N=1,IDIM
  65 :           XM2=XM2+((XCOOR((IPI-1)*(IDIM+1)+N)
  66 :      $        -XCOOR((IPC-1)*(IDIM+1)+N))*MPOVA1.VPOCHA(K,N))
  67 :  325      CONTINUE
  68 :           XM2=ABS(XM2)*2
  69 :           XMI2=VPOCHA(LECT(IPC),1)
  70 :           VPOCHA(LECT(IPC),1)=MIN(XM2,XMI2)
  71 : C  Point droit
  72 :           IPC=IPT1.NUM(3,K)
  73 :           XM2=0.D0
  74 :           DO 326 N=1,IDIM
  75 :           XM2=XM2+((XCOOR((IPI-1)*(IDIM+1)+N)
  76 :      $        -XCOOR((IPC-1)*(IDIM+1)+N))*MPOVA1.VPOCHA(K,N))
  77 :  326      CONTINUE
  78 :           XM2=ABS(XM2)*2
  79 :           XMI2=VPOCHA(LECT(IPC),1)
  80 :           VPOCHA(LECT(IPC),1)=MIN(XM2,XMI2)
  81 : C
  82 : *            IF(XMI2.LT.XPETI2) WRITE(6,*)
  83 : *     $           'kdmi.eso : un element est peut-etre degenere'
  84 : 
  85 :  10      CONTINUE
  86 :       SEGDES IPT1
  87 :       SEGDES IPT2
  88 :       SEGDES MPOVAL
  89 :       SEGDES MPOVA1
  90 :       SEGSUP MLENTI
  91 : C
  91 :       CALL ECROBJ('CHPOINT ',MCHPOI)
  92 : 
  93 :       RETURN
  94 : 
  95 :  90   CONTINUE
  96 : *      WRITE(6,*)' Interruption anormale dans kdmi.eso'
  97 :       RETURN
  98 :  1001 FORMAT(20(1X,I5))
  99 :       END
 100 : 
 101 : 
 102 :  
 103 :  
 104 :  
 105 :  
 106 :  
 107 :