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    CB215821  20/11/25    13:31:04     10792          
  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. C
  40. C**** Variables de COOPTIO
  41. C
  42. C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  43. C     &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  44. C     &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  45. C     &     ,IECHO,   IIMPI,  IOSPI
  46. C     &     ,IDIM,    IFICLE, IPREFI
  47. CC     &     ,MCOORD
  48. C     &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  49. C     &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  50. C     &     ,NORINC,NORVAL,NORIND,NORVAD
  51. C     &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  52. CC
  53.       IMPLICIT INTEGER(I-N)
  54.       INTEGER JGN, JGM, NBS, ICEN, IELEM, NBELEM, NBNN, INOEU, IGEOM
  55.      &     , ISOUS, NCEN, NFAC, IFAC, MCHDIA, MCHPNO
  56.       REAL*8 USDIA, RNORX, RNORY, RNORZ, RDISX, RDISY, RDISZ, USDIA0
  57.      &     ,XCEN(3)
  58.       CHARACTER*8 TYPI
  59. C
  60.  
  61. -INC PPARAM
  62. -INC CCOPTIO
  63. -INC SMELEME
  64. -INC SMLENTI
  65. -INC SMCHPOI
  66. -INC SMLMOTS
  67. -INC SMCOORD
  68. C
  69.       POINTEUR MELTFA.MELEME, MELCEN.MELEME, MPOVNO.MPOVAL
  70.      &     , MPODIA.MPOVAL, MELFAC.MELEME
  71. C
  72. C**** Position of the FACE points into MELFAC
  73. C
  74.       CALL KRIPAD(MELFAC,MLENTI)
  75. C     SEGINI MLENTI
  76. C
  77. C**** Normals
  78. C
  79.       CALL LICHT(MCHPNO,MPOVNO,TYPI,IGEOM)
  80. C      SEGACT MPOVNO*MOD
  81. C
  82. C**** Diamin
  83. C
  84.       TYPI='CENTRE  '
  85.       JGN=4
  86.       JGM=1
  87.       SEGINI MLMOTS
  88.       MLMOTS.MOTS(1)='SCAL'
  89.       CALL KRCHP1(TYPI,MELCEN,MCHDIA,MLMOTS)
  90.       CALL LICHT(MCHDIA,MPODIA,TYPI,IGEOM)
  91. C     SEGACT MPODIA*MOD
  92.       SEGSUP MLMOTS
  93. C
  94.       SEGACT MELTFA
  95.       SEGACT MELCEN
  96.       NBS=MELTFA.LISOUS(/1)
  97.       IF(NBS .EQ. 0) NBS=1
  98. C
  99.       ICEN=0
  100.       DO ISOUS=1,NBS,1
  101.          IF(NBS .NE. 1)THEN
  102.             IPT1=MELTFA.LISOUS(ISOUS)
  103.             SEGACT IPT1
  104.          ELSE
  105.             IPT1=MELTFA
  106.          ENDIF
  107. C
  108.          NBELEM=IPT1.NUM(/2)
  109.          NBNN=IPT1.NUM(/1)
  110. C
  111.          DO IELEM=1,NBELEM,1
  112.             ICEN=ICEN+1
  113.             NCEN=MELCEN.NUM(1,ICEN)
  114.             USDIA=0.0D0
  115.             XCEN(1)=XCOOR((NCEN-1)*(IDIM+1)+1)
  116.             XCEN(2)=XCOOR((NCEN-1)*(IDIM+1)+2)
  117.             IF(IDIM .EQ. 3) XCEN(3)=XCOOR((NCEN-1)*(IDIM+1)+3)
  118.             DO INOEU=1,NBNN,1
  119.                NFAC=IPT1.NUM(INOEU,IELEM)
  120.                IFAC=MLENTI.LECT(NFAC)
  121.                RNORX=MPOVNO.VPOCHA(IFAC,1)
  122.                RNORY=MPOVNO.VPOCHA(IFAC,2)
  123.                RDISX=XCOOR((NFAC-1)*(IDIM+1)+1)-XCEN(1)
  124.                RDISY=XCOOR((NFAC-1)*(IDIM+1)+2)-XCEN(2)
  125.                USDIA0=(RNORX*RDISX)+(RNORY*RDISY)
  126.                IF(IDIM .EQ. 3)THEN
  127.                   RNORZ=MPOVNO.VPOCHA(IFAC,3)
  128.                   RDISZ=XCOOR((NFAC-1)*(IDIM+1)+3)-XCEN(3)
  129.                   USDIA0=USDIA0+(RNORZ*RDISZ)
  130.                ENDIF
  131.                USDIA0=1.0D0/ABS(USDIA0)
  132.                IF(USDIA0 .GE. USDIA) USDIA=USDIA0
  133.             ENDDO
  134.             MPODIA.VPOCHA(ICEN,1)=2.0D0/USDIA
  135.          ENDDO
  136.          IF(NBS .NE. 1) SEGDES IPT1
  137.       ENDDO
  138. C
  139.       SEGDES MELTFA
  140.       SEGDES MELCEN
  141.       SEGDES MPODIA
  142.       SEGDES MPOVNO
  143.       SEGSUP MLENTI
  144. C
  145.       RETURN
  146. C
  147.       END
  148.  
  149.  
  150.  
  151.  
  152.  

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