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

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