Télécharger krempa.eso

Retour à la liste

Numérotation des lignes :

  1. C KREMPA SOURCE CB215821 16/04/21 21:17:36 8920
  2. SUBROUTINE KREMPA (K2,KG,NG,NF,NA,NAL,C,U2,
  3. - SHC3D,SKCEL,SPROJA,SKBUFF)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. DIMENSION U2(1),KG(2)
  7. C----------------------------------------------------------------------
  8. C Calcul des facteurs de forme en 3D
  9. C Sp appele par la famille KREMxG
  10. C
  11. C CELLULES-ARETES
  12. C ---------------
  13. C
  14. C DETERMINATION DES CELLULES SITUEES SUR LA FACE 'NF' APPARTENANT
  15. C A LA PROJECTION DE L'ARETE 'NA' DE L'ELEMENT 'K2'
  16. C
  17. C NA : INDICE DE L'ARETE
  18. C U2 : NORMALE DE L'ELEMENT K2
  19. C
  20. C NAL : INDICE DU NUMERO DE FACE DANS L'ARETE 1,2 OU 3
  21. C SI 3 ON CALCULE NF
  22. C
  23. C SI NFA = 3 : SEUL CAS OU ON CALCULE NF
  24. C----------------------------------------------------------------------
  25.  
  26. -INC TFFOR3D
  27. SEGMENT SKCEL
  28. INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  29. REAL*8 RMAX
  30. ENDSEGMENT
  31. C
  32. IF(NAL.NE.3) THEN
  33.  
  34. IF(NF.EQ.IFA(NAL,NA)) THEN
  35. LF = 1
  36. ELSE
  37. LF = 2
  38. ENDIF
  39. ELSE
  40. IF (NFA(NA).EQ.3) THEN
  41. LF = 3
  42. NF = IFA(3,NA)
  43. ELSE
  44. IF (IFA(3,NA).EQ.NF) THEN
  45. LF = 3
  46. ELSE
  47. LF = 4
  48. ENDIF
  49. ENDIF
  50. ENDIF
  51. C
  52. KG(1) = KG(1) + IG(LF,1,NA)
  53. KG(2) = KG(2) + IG(LF,2,NA)
  54. NG = NG + 1
  55. C
  56. NOC = NUMF(/2)
  57. DO 403 KC = 1,NCEL(LF,NA)
  58. I = ICEL(LF,1,KC,NA)
  59. J = ICEL(LF,2,KC,NA)
  60. KBCEL(I,J) = 1
  61. C
  62.  
  63. IF (PSC(NF,I,J).GT.-1.) THEN
  64. B = 0.
  65. DO 40 IES = 1,KES
  66. B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I,J)
  67. 40 CONTINUE
  68. C
  69. C CELLULE SOMMET OU ARETE
  70. C
  71. IF (ABS(B).GT.0.0001) THEN
  72. Z = - C / B
  73. DFF = Z - ZB(NF,I,J)
  74. DIFF = ABS(DFF)
  75. NTY = NTYP(NF,I,J)
  76. IF (DIFF.LT.1E-4.AND.NTY.LT.NOC) THEN
  77. DO 100 KT=1,NTY
  78. K = NUMF(NF,KT,I,J)
  79. IF (K.EQ.K2) GOTO 101
  80. 100 CONTINUE
  81. NTY = NTY + 1
  82. NUMF(NF,NTY,I,J) = K2
  83. NTYP(NF,I,J) = NTY
  84. 101 CONTINUE
  85. ELSE
  86. IF (DFF.LT.-1E-3.AND.Z.GT.1E-4) THEN
  87. ZB(NF,I,J) = Z
  88. NUMF(NF,1,I,J) = K2
  89. NTYP(NF,I,J) = 1
  90. ENDIF
  91. ENDIF
  92. ENDIF
  93. ENDIF
  94. 403 CONTINUE
  95.  
  96. RETURN
  97. END
  98.  
  99.  
  100.  
  101.  
  102.  

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