C KDOM12    SOURCE    OF166741  24/12/13    21:15:59     12097          
      SUBROUTINE KDOM12(MELTFA,MELCEN,MELFAC,MCHPNO,MCHDIA)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KDOM12
C
C DESCRIPTION       :  Subroutine called by KDOM10 and KDOM4A in the
C                      case of EULER model
C                      We create the minimum diameter of each elts
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
C
C************************************************************************
C
C INPUT :
C
C MELTFA : MELEME 'ELTFA'
C
C MELCEN : MELEME 'CENTRE'
C
C MELFAC : MELEME 'FACE'
C
C MCHPNO : CHPOINT 'XXNORMAF'
C
C OUTPUT
C
C MCHDIA : CHPOINT 'XXDIEMIN'
C
C
C************************************************************************
C
C Created the 24/02/04
C
      IMPLICIT INTEGER(I-N)

      INTEGER JGN, JGM, NBS, ICEN, IELEM, NBELEM, NBNN, INOEU, IGEOM
     &     , ISOUS, NCEN, NFAC, IFAC, MCHDIA, MCHPNO
      REAL*8 USDIA, RNORX, RNORY, RNORZ, RDISX, RDISY, RDISZ, USDIA0
     &     ,XCEN(3)
      CHARACTER*8 TYPI
C

-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMLENTI
-INC SMCHPOI
-INC SMLMOTS
-INC SMCOORD
C
      POINTEUR MELTFA.MELEME, MELCEN.MELEME, MPOVNO.MPOVAL
     &     , MPODIA.MPOVAL, MELFAC.MELEME
C
C**** Position of the FACE points into MELFAC
C
      CALL KRIPAD(MELFAC,MLENTI)
C     SEGINI MLENTI
C
C**** Normals
C
      CALL LICHT(MCHPNO,MPOVNO,TYPI,IGEOM)
C      SEGACT MPOVNO*MOD
C
C**** Diamin
C
      TYPI='CENTRE  '
      JGN=4
      JGM=1
      SEGINI MLMOTS
      MLMOTS.MOTS(1)='SCAL'
      CALL KRCHP1(TYPI,MELCEN,MCHDIA,MLMOTS)
      CALL LICHT(MCHDIA,MPODIA,TYPI,IGEOM)
C     SEGACT MPODIA*MOD
      SEGSUP MLMOTS
C
      SEGACT MELTFA
      SEGACT MELCEN
      NBS=MELTFA.LISOUS(/1)
      IF(NBS .EQ. 0) NBS=1
C
      ICEN=0
      DO ISOUS=1,NBS,1
         IF(NBS .NE. 1)THEN
            IPT1=MELTFA.LISOUS(ISOUS)
            SEGACT IPT1
         ELSE
            IPT1=MELTFA
         ENDIF
C
         NBELEM=IPT1.NUM(/2)
         NBNN=IPT1.NUM(/1)
C
         DO IELEM=1,NBELEM,1
            ICEN=ICEN+1
            NCEN=MELCEN.NUM(1,ICEN)
            USDIA=0.0D0
            XCEN(1)=XCOOR((NCEN-1)*(IDIM+1)+1)
            XCEN(2)=XCOOR((NCEN-1)*(IDIM+1)+2)
            IF(IDIM .EQ. 3) XCEN(3)=XCOOR((NCEN-1)*(IDIM+1)+3)
            DO INOEU=1,NBNN,1
               NFAC=IPT1.NUM(INOEU,IELEM)
               IFAC=MLENTI.LECT(NFAC)
               RNORX=MPOVNO.VPOCHA(IFAC,1)
               RNORY=MPOVNO.VPOCHA(IFAC,2)
               RDISX=XCOOR((NFAC-1)*(IDIM+1)+1)-XCEN(1)
               RDISY=XCOOR((NFAC-1)*(IDIM+1)+2)-XCEN(2)
               USDIA0=(RNORX*RDISX)+(RNORY*RDISY)
               IF(IDIM .EQ. 3)THEN
                  RNORZ=MPOVNO.VPOCHA(IFAC,3)
                  RDISZ=XCOOR((NFAC-1)*(IDIM+1)+3)-XCEN(3)
                  USDIA0=USDIA0+(RNORZ*RDISZ)
               ENDIF
               USDIA0=1.0D0/ABS(USDIA0)
               IF(USDIA0 .GE. USDIA) USDIA=USDIA0
            ENDDO
            MPODIA.VPOCHA(ICEN,1)=2.0D0/USDIA
         ENDDO
         IF(NBS .NE. 1) SEGDES IPT1
      ENDDO
C
      SEGDES MELTFA
      SEGDES MELCEN
      SEGDES MPODIA
      SEGDES MPOVNO
      SEGSUP MLENTI
C
      RETURN
C
      END