Télécharger kdmi.eso

Retour à la liste

Numérotation des lignes :

  1. C KDMI SOURCE PV 09/03/12 21:26:04 6325
  2. SUBROUTINE KDMI
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C
  7. C OBJET : Cree un CHAMPOINT CENTRE contenant le diametre min des
  8. C éléments du domaine
  9. C
  10. C SYNTAXE : CHPC = KDMI OBJDOM ;
  11. C
  12. C OBJDOM : TABLE de SOUSTYPE DOMAINE
  13. C
  14. C*************************************************************************
  15. -INC CCREEL
  16. -INC CCOPTIO
  17. -INC SMELEME
  18. POINTEUR MELEMC.MELEME, MELEMF.MELEME
  19. -INC SMCOORD
  20. -INC SMCHPOI
  21. -INC SMLENTI
  22. -INC SMCHAML
  23. * PARAMETER (XPETI2=XPETIT**2)
  24. PARAMETER (NTB=1)
  25. CHARACTER*8 LTAB(NTB),TYPE,TYPC
  26. DIMENSION KTAB(NTB)
  27. DATA LTAB/'DOMAINE '/
  28. C***
  29. NTO=NTB
  30. CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  31. IF(IRET.EQ.0)RETURN
  32. MTABD=KTAB(1)
  33.  
  34. TYPE=' '
  35. CALL ACMO(MTABD,'CENTRE',TYPE,MELEMC)
  36. IF(TYPE.NE.'MAILLAGE')GO TO 90
  37. CALL ACMO(MTABD,'FACEL',TYPE,MELEMF)
  38. IF(TYPE.NE.'MAILLAGE')GO TO 90
  39. TYPE=' '
  40. CALL ACMO(MTABD,'XXNORMAF',TYPE,MCHPO1)
  41. IF (TYPE.NE.'CHPOINT ') THEN
  42. CALL KNRF(MTABD,MCHELM,MCHPO1,MCHPO2)
  43. SEGSUP MCHELM
  44. SEGSUP MCHPO2
  45. ENDIF
  46. NC=1
  47. TYPE='CENTRE'
  48. CALL CRCHPT(TYPE,MELEMC,NC,MCHPOI)
  49. C In LICHT -> SEGACT MPOVAL*MOD
  50. CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM)
  51. CALL LICHT(MCHPO1,MPOVA1,TYPC,IGEOM)
  52. TYPE=' '
  53. IPT1=MELEMF
  54. SEGACT IPT1
  55. IPT2=MELEMC
  56. SEGACT IPT2
  57. CALL KRIPAD(IPT2,MLENTI)
  58. SEGACT MLENTI
  59. NF=IPT1.NUM(/2)
  60. NEL=IPT2.NUM(/2)
  61. DO 5 K=1,NEL
  62. C# VPOCHA(K,1)=XGRAND**2
  63. VPOCHA(K,1)=XGRAND
  64. 5 CONTINUE
  65. DO 10 K=1,NF
  66. C CALCUL DU DIAMETRE MIN
  67. C PRODUIT SCALAIRE DE LA NORMALE A LA FACE ET DU VECTEUR
  68. C CENTRE/FACE
  69. IPI=IPT1.NUM(2,K)
  70. C Point gauche
  71. IPC=IPT1.NUM(1,K)
  72. XM2=0.D0
  73. DO 325 N=1,IDIM
  74. XM2=XM2+((XCOOR((IPI-1)*(IDIM+1)+N)
  75. $ -XCOOR((IPC-1)*(IDIM+1)+N))*MPOVA1.VPOCHA(K,N))
  76. 325 CONTINUE
  77. XM2=ABS(XM2)*2
  78. XMI2=VPOCHA(LECT(IPC),1)
  79. VPOCHA(LECT(IPC),1)=MIN(XM2,XMI2)
  80. C Point droit
  81. IPC=IPT1.NUM(3,K)
  82. XM2=0.D0
  83. DO 326 N=1,IDIM
  84. XM2=XM2+((XCOOR((IPI-1)*(IDIM+1)+N)
  85. $ -XCOOR((IPC-1)*(IDIM+1)+N))*MPOVA1.VPOCHA(K,N))
  86. 326 CONTINUE
  87. XM2=ABS(XM2)*2
  88. XMI2=VPOCHA(LECT(IPC),1)
  89. VPOCHA(LECT(IPC),1)=MIN(XM2,XMI2)
  90. C
  91. * IF(XMI2.LT.XPETI2) WRITE(6,*)
  92. * $ 'kdmi.eso : un element est peut-etre degenere'
  93.  
  94. 10 CONTINUE
  95. SEGDES IPT1
  96. SEGDES IPT2
  97. SEGDES MPOVAL
  98. SEGDES MPOVA1
  99. SEGSUP MLENTI
  100. C
  101. CALL ECROBJ('CHPOINT ',MCHPOI)
  102.  
  103. RETURN
  104.  
  105. 90 CONTINUE
  106. * WRITE(6,*)' Interruption anormale dans kdmi.eso'
  107. RETURN
  108. 1001 FORMAT(20(1X,I5))
  109. END
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  

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