Sources Esope | Cast3M

kdmi
C KDMI      SOURCE    CB215821  20/11/25    13:31:00     10792          
      SUBROUTINE KDMI
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*************************************************************************
C
C     OBJET   : Cree un CHAMPOINT CENTRE contenant le diametre min des
C               éléments du domaine
C
C     SYNTAXE : CHPC = KDMI OBJDOM ;
C
C                      OBJDOM : TABLE de SOUSTYPE DOMAINE
C
C*************************************************************************
-INC CCREEL
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
      POINTEUR MELEMC.MELEME, MELEMF.MELEME
-INC SMCOORD
-INC SMCHPOI
-INC SMLENTI
-INC SMCHAML
*      PARAMETER (XPETI2=XPETIT**2)
      PARAMETER (NTB=1)
      CHARACTER*8 LTAB(NTB),TYPE,TYPC
      DIMENSION KTAB(NTB)
      DATA LTAB/'DOMAINE '/
C***
      NTO=NTB
      CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
      IF(IRET.EQ.0)RETURN
      MTABD=KTAB(1)
 
      TYPE=' '
      CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
      IF(TYPE.NE.'MAILLAGE')GO TO 90
      CALL ACMO(MTABD,'FACEL',TYPE,MELEMF)
      IF(TYPE.NE.'MAILLAGE')GO TO 90
      TYPE=' '
      CALL ACMO(MTABD,'XXNORMAF',TYPE,MCHPO1)
      IF (TYPE.NE.'CHPOINT ') THEN
      CALL KNRF(MTABD,MCHELM,MCHPO1,MCHPO2)
      SEGSUP MCHELM
      SEGSUP MCHPO2
      ENDIF
      NC=1
      TYPE='CENTRE'
      CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI)
C     In LICHT -> SEGACT MPOVAL*MOD
      CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
      CALL LICHT(MCHPO1,MPOVA1,TYPC,IGEOM)
      TYPE=' '
      IPT1=MELEMF
      SEGACT IPT1
      IPT2=MELEMC
      SEGACT IPT2
      CALL KRIPAD(IPT2,MLENTI)
      SEGACT MLENTI
      NF=IPT1.NUM(/2)
      NEL=IPT2.NUM(/2)
      DO 5 K=1,NEL
C#          VPOCHA(K,1)=XGRAND**2
          VPOCHA(K,1)=XGRAND
 5    CONTINUE
      DO 10 K=1,NF
C             CALCUL DU DIAMETRE MIN
C         PRODUIT SCALAIRE DE LA NORMALE A LA FACE ET DU VECTEUR
C         CENTRE/FACE
          IPI=IPT1.NUM(2,K)
C  Point gauche
          IPC=IPT1.NUM(1,K)
          XM2=0.D0
          DO 325 N=1,IDIM
          XM2=XM2+((XCOOR((IPI-1)*(IDIM+1)+N)
     $        -XCOOR((IPC-1)*(IDIM+1)+N))*MPOVA1.VPOCHA(K,N))
 325      CONTINUE
          XM2=ABS(XM2)*2
          XMI2=VPOCHA(LECT(IPC),1)
          VPOCHA(LECT(IPC),1)=MIN(XM2,XMI2)
C  Point droit
          IPC=IPT1.NUM(3,K)
          XM2=0.D0
          DO 326 N=1,IDIM
          XM2=XM2+((XCOOR((IPI-1)*(IDIM+1)+N)
     $        -XCOOR((IPC-1)*(IDIM+1)+N))*MPOVA1.VPOCHA(K,N))
 326      CONTINUE
          XM2=ABS(XM2)*2
          XMI2=VPOCHA(LECT(IPC),1)
          VPOCHA(LECT(IPC),1)=MIN(XM2,XMI2)
C
*            IF(XMI2.LT.XPETI2) WRITE(6,*)
*     $           'kdmi.eso : un element est peut-etre degenere'
 
 10      CONTINUE
      SEGDES IPT1
      SEGDES IPT2
      SEGDES MPOVAL
      SEGDES MPOVA1
      SEGSUP MLENTI
C
      CALL ECROBJ('CHPOINT ',MCHPOI)
 
      RETURN
 
 90   CONTINUE
*      WRITE(6,*)' Interruption anormale dans kdmi.eso'
      RETURN
 1001 FORMAT(20(1X,I5))
      END