Esope source files

   1 : C KDOM12    SOURCE    CHAT      05/01/13    00:53:43     5004           
   2 :       SUBROUTINE KDOM12(MELTFA,MELCEN,MELFAC,MCHPNO,MCHDIA)
   3 : C
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  KDOM12
   9 : C                      
   9 : C DESCRIPTION       :  Subroutine called by KDOM10 and KDOM4A in the
  10 : C                      case of EULER model
  11 : C                      We create the minimum diameter of each elts
  12 : C     
  13 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  14 : C      
  15 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF                        
  16 : C
  17 : C************************************************************************
  18 : C
  19 : C INPUT : 
  20 : C
  21 : C MELTFA : MELEME 'ELTFA'
  22 : C
  23 : C MELCEN : MELEME 'CENTRE'
  24 : C
  25 : C MELFAC : MELEME 'FACE'
  26 : C
  27 : C MCHPNO : CHPOINT 'XXNORMAF'
  28 : C
  29 : C OUTPUT
  30 : C 
  31 : C MCHDIA : CHPOINT 'XXDIEMIN'
  32 : C
  33 : C
  34 : C************************************************************************
  35 : C
  36 : C Created the 24/02/04
  37 : C
  38 : C
  39 : C**** Variables de COOPTIO
  40 : C
  41 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  42 : C     &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  43 : C     &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  44 : C     &     ,IECHO,   IIMPI,  IOSPI
  45 : C     &     ,IDIM,    IFICLE, IPREFI     
  46 : CC     &     ,MCOORD
  47 : C     &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  48 : C     &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  49 : C     &     ,NORINC,NORVAL,NORIND,NORVAD
  50 : C     &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  51 : CC
  52 :       IMPLICIT INTEGER(I-N)
  53 :       INTEGER JGN, JGM, NBS, ICEN, IELEM, NBELEM, NBNN, INOEU, IGEOM
  54 :      &     , ISOUS, NCEN, NFAC, IFAC, MCHDIA, MCHPNO
  55 :       REAL*8 USDIA, RNORX, RNORY, RNORZ, RDISX, RDISY, RDISZ, USDIA0
  56 :      &     ,XCEN(3)
  57 :       CHARACTER*8 TYPI
  58 : C
  59 : -INC CCOPTIO
  60 : -INC SMELEME
  61 : -INC SMLENTI
  62 : -INC SMCHPOI
  63 : -INC SMLMOTS
  64 : -INC SMCOORD
  65 : C
  66 :       POINTEUR MELTFA.MELEME, MELCEN.MELEME, MPOVNO.MPOVAL
  67 :      &     , MPODIA.MPOVAL, MELFAC.MELEME
  68 : C
  69 : C**** Position of the FACE points into MELFAC
  70 : C      
  70 :       CALL KRIPAD(MELFAC,MLENTI)
  71 : C     SEGINI MLENTI
  72 : C
  73 : C**** Normals
  74 : C
  74 :       CALL LICHT(MCHPNO,MPOVNO,TYPI,IGEOM)
  75 : C      SEGACT MPOVNO*MOD
  76 : C
  77 : C**** Diamin
  78 : C
  79 :       TYPI='CENTRE  '
  80 :       JGN=4
  81 :       JGM=1
  82 :       SEGINI MLMOTS
  83 :       MLMOTS.MOTS(1)='SCAL'
  83 :       CALL KRCHP1(TYPI,MELCEN,MCHDIA,MLMOTS)
  83 :       CALL LICHT(MCHDIA,MPODIA,TYPI,IGEOM)
  84 : C     SEGACT MPODIA*MOD
  85 :       SEGSUP MLMOTS
  86 : C
  87 :       SEGACT MELTFA
  88 :       SEGACT MELCEN
  89 :       NBS=MELTFA.LISOUS(/1)
  90 :       IF(NBS .EQ. 0) NBS=1
  91 : C
  92 :       ICEN=0
  93 :       DO ISOUS=1,NBS,1
  94 :          IF(NBS .NE. 1)THEN
  95 :             IPT1=MELTFA.LISOUS(ISOUS)
  96 :             SEGACT IPT1
  97 :          ELSE
  98 :             IPT1=MELTFA
  99 :          ENDIF
 100 : C
 101 :          NBELEM=IPT1.NUM(/2)
 102 :          NBNN=IPT1.NUM(/1)
 103 : C
 104 :          DO IELEM=1,NBELEM,1
 105 :             ICEN=ICEN+1
 106 :             NCEN=MELCEN.NUM(1,ICEN)
 107 :             USDIA=0.0D0
 108 :             XCEN(1)=XCOOR((NCEN-1)*(IDIM+1)+1)
 109 :             XCEN(2)=XCOOR((NCEN-1)*(IDIM+1)+2)
 110 :             IF(IDIM .EQ. 3) XCEN(3)=XCOOR((NCEN-1)*(IDIM+1)+3)
 111 :             DO INOEU=1,NBNN,1
 112 :                NFAC=IPT1.NUM(INOEU,IELEM)
 113 :                IFAC=MLENTI.LECT(NFAC)
 114 :                RNORX=MPOVNO.VPOCHA(IFAC,1)
 115 :                RNORY=MPOVNO.VPOCHA(IFAC,2)
 116 :                RDISX=XCOOR((NFAC-1)*(IDIM+1)+1)-XCEN(1)
 117 :                RDISY=XCOOR((NFAC-1)*(IDIM+1)+2)-XCEN(2)
 118 :                USDIA0=(RNORX*RDISX)+(RNORY*RDISY)
 119 :                IF(IDIM .EQ. 3)THEN
 120 :                   RNORZ=MPOVNO.VPOCHA(IFAC,3)
 121 :                   RDISZ=XCOOR((NFAC-1)*(IDIM+1)+3)-XCEN(3)
 122 :                   USDIA0=USDIA0+(RNORZ*RDISZ)
 123 :                ENDIF
 124 :                USDIA0=1.0D0/ABS(USDIA0)
 125 :                IF(USDIA0 .GE. USDIA) USDIA=USDIA0
 126 :             ENDDO
 127 :             MPODIA.VPOCHA(ICEN,1)=2.0D0/USDIA
 128 :          ENDDO
 129 :          IF(NBS .NE. 1) SEGDES IPT1
 130 :       ENDDO
 131 : C      
 132 :       SEGDES MELTFA
 133 :       SEGDES MELCEN
 134 :       SEGDES MPODIA
 135 :       SEGDES MPOVNO
 136 :       SEGSUP MLENTI
 137 : C
 138 :       RETURN
 139 : C     
 140 :       END
 141 :  
 142 :  
 143 :