Télécharger la plaquette Cast3M


fr en

Télécharger kdom12.eso

Retour à la liste

Numérotation des lignes : 

kdom12

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales