Télécharger kprojg.eso

Retour à la liste

Numérotation des lignes :

  1. C KPROJG SOURCE CHAT 05/01/13 01:05:17 5004
  2. SUBROUTINE KPROJG(K2,NS1,NS2,NS3,NF1,NF2,NF3,NA1,NA2,NA3
  3. * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF,SPROJP,KERR)
  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 KPROJF
  9. C
  10. C
  11. C----------------------------------------------------------------------
  12. C
  13. DIMENSION U2(4)
  14. C
  15. -INC TFFOR3D
  16. SEGMENT SKSEGM
  17. INTEGER KKSEGM(2,NSEGM)
  18. ENDSEGMENT
  19. C
  20. C DESCRIPTION DES ARETES
  21. C
  22. SEGMENT SPROJP
  23. INTEGER KF(NPT),ICOO(2,NPT)
  24. REAL*8 XR(3,NPT)
  25. ENDSEGMENT
  26. SEGMENT SKCEL
  27. INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  28. REAL*8 RMAX
  29. ENDSEGMENT
  30. C
  31. C--------------------------------------------------------------------
  32. NR = IR(/1)
  33. C
  34. IF(NF1.EQ.NF2) THEN
  35. IF(NF2.EQ.NF3) THEN
  36. C
  37. C 1 FACE
  38. C -------
  39. C
  40. CALL KREM1G(K2,NF1,NF2,NF3,NA1,NA2,NA3
  41. * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  42. ELSE
  43. C
  44. C 2 FACES DIFFERENTES NON PARALLELES
  45. C ----------------------------------
  46. C
  47. IF (KA(NF2).EQ.KA(NF3)) GOTO 500
  48. CALL KREM2G(K2,NF2,NF3,NA2,NA3,NA1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  49. ENDIF
  50.  
  51. ELSE
  52. IF (NF3.EQ.NF2) THEN
  53. IF (KA(NF1).EQ.KA(NF2)) GOTO 500
  54. CALL KREM2G(K2,NF2,NF1,NA1,NA3,NA2,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  55.  
  56. ELSE
  57. IF (NF3.EQ.NF1) THEN
  58. IF (KA(NF1).EQ.KA(NF2)) GOTO 500
  59. CALL KREM2G(K2,NF1,NF2,NA1,NA2,NA3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  60.  
  61. ELSE
  62. C
  63. C 3 FACES DIFFERENTES NON PARALLELES
  64. C ----------------------------------
  65.  
  66. IF (KA(NF1).EQ.KA(NF2)) GOTO 600
  67. IF (KA(NF2).EQ.KA(NF3)) GOTO 600
  68. IF (KA(NF3).EQ.KA(NF1)) GOTO 600
  69. CALL KREM3G(K2,NS1,NS2,NS3,NF1,NF2,NF3,NA1,NA2,NA3
  70. * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF,SPROJP)
  71. C
  72. ENDIF
  73. ENDIF
  74. ENDIF
  75. KERR = 0
  76. RETURN
  77. C
  78. 500 CONTINUE
  79. KERR =2
  80. RETURN
  81. 600 CONTINUE
  82. KERR =3
  83. RETURN
  84. END
  85.  
  86.  
  87.  

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