Télécharger krem3g.eso

Retour à la liste

Numérotation des lignes :

  1. C KREM3G SOURCE CHAT 05/01/13 01:06:19 5004
  2. SUBROUTINE KREM3G(K2,NS1,NS2,NS3,NF1,NF2,NF3,NA1,NA2,NA3
  3. * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF,SPROJP)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C----------------------------------------------------------------------
  7. C Calcul des facteurs de forme en 3D
  8. C Sp appele par KPROJG
  9. C
  10. C CAS DE 3 FACES DIFFERENTES NON PARALLELES
  11. C -----------------------------------------
  12. C
  13. C----------------------------------------------------------------------
  14. C
  15. DIMENSION U2(4),KC1(2),KG(2),KH(2)
  16. -INC TFFOR3D
  17. C
  18. SEGMENT SPROJP
  19. INTEGER KF(NPT),ICOO(2,NPT)
  20. REAL*8 XR(3,NPT)
  21. ENDSEGMENT
  22. C
  23. SEGMENT SKSEGM
  24. INTEGER KKSEGM(2,NSEGM)
  25. ENDSEGMENT
  26. C
  27. C DESCRIPTION DES ARETES
  28. C
  29. SEGMENT SKCEL
  30. INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  31. REAL*8 RMAX
  32. ENDSEGMENT
  33. C
  34. C--------------------------------------------------------------------
  35. NR = IR(/1)
  36. C
  37. C WRITE(6,*) ' KREM3G K2 ',K2
  38. C WRITE(6,*) ' NF ',NF1,NF2,NF3
  39. C WRITE(6,*) ' NFA ',NFA(NA1),NFA(NA2),NFA(NA3)
  40. C
  41. C
  42. C
  43. IF (NFA(NA1).NE.3.AND.NFA(NA2).NE.3.AND.NFA(NA3).NE.3) THEN
  44. C
  45. C PAS DE FACE GENEREE
  46. C -------------------
  47. C
  48. CALL KINITB(KBCEL,NR,NR,KG,NG)
  49. CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  50. CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  51. CALL KFINSO(NF2,NF3,KA,IM,KH)
  52. KG(1) = ( KG(1)/2 + KH(1) )/2
  53. KG(2) = ( KG(2)/2 + KH(2) )/2
  54. CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  55.  
  56. CALL KINITB(KBCEL,NR,NR,KG,NG)
  57. CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  58. CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  59. CALL KFINSO(NF1,NF3,KA,IM,KH)
  60. KG(1) = ( KG(1)/2 + KH(1) )/2
  61. KG(2) = ( KG(2)/2 + KH(2) )/2
  62. CALL KREMPI(NIN,K2,KG,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  63.  
  64. CALL KINITB(KBCEL,NR,NR,KG,NG)
  65. CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  66. CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  67. CALL KFINSO(NF1,NF2,KA,IM,KH)
  68. KG(1) = ( KG(1)/2 + KH(1) )/2
  69. KG(2) = ( KG(2)/2 + KH(2) )/2
  70. CALL KREMPI(NIN,K2,KG,1,NF3,C,U2,SHC3D,SKCEL,SKBUFF)
  71.  
  72. ELSE
  73. C
  74. C IL EXISTE UNE FACE GENEREE
  75. C ---------------------------
  76. C
  77. IF (NFA(NA2).EQ.3) THEN
  78. KC1(1) = ICOO(1,NS1)
  79. KC1(2) = ICOO(2,NS1)
  80. CALL KREM3F(K2,KG,NG,KC1,NA2,NF2,NF3,NF1,NA3,NA1
  81. - ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  82. ENDIF
  83. C
  84. IF (NFA(NA3).EQ.3) THEN
  85. KC1(1) = ICOO(1,NS2)
  86. KC1(2) = ICOO(2,NS2)
  87. CALL KREM3F(K2,KG,NG,KC1,NA3,NF3,NF1,NF2,NA1,NA2
  88. - ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  89. ENDIF
  90.  
  91. IF (NFA(NA1).EQ.3) THEN
  92. KC1(1) = ICOO(1,NS3)
  93. KC1(2) = ICOO(2,NS3)
  94. CALL KREM3F(K2,KG,NG,KC1,NA1,NF1,NF2,NF3,NA2,NA3
  95. - ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  96. ENDIF
  97.  
  98. ENDIF
  99. C
  100. RETURN
  101. END
  102.  
  103.  
  104.  

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