Télécharger ksubcr.eso

Retour à la liste

Numérotation des lignes :

  1. C KSUBCR SOURCE CHAT 05/01/13 01:09:07 5004
  2. SUBROUTINE KSUBCR(O1,KSUB,NSUB,AA,SHC3D,SPROGP,SPROJA)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C----------------------------------------------------------------------
  6. C Calcul des facteurs de forme en 3D
  7. C Sp appele par Kprojf
  8. C Determination de la projection des sommets et des aretes
  9. C
  10. C O1 : POINT DE VUE PRIS SUR K1
  11. C AA : SOMMETS DU TRIANGLE DE LA FACE K2
  12. C U2 : NORMALE A LA FACE K2
  13. C
  14. C----------------------------------------------------------------------
  15. C
  16. DIMENSION U2(4),AA(3,3,4)
  17. DIMENSION X1(3),X2(3),KC1(2),KC2(2)
  18. DIMENSION O1(3),O2(3),XG1(3),XG2(3)
  19. DIMENSION KG(2),KH(2)
  20. -INC TFFOR3D
  21. SEGMENT SPROGP
  22. INTEGER KF(NPT),ICOO(2,NPT)
  23. REAL*8 XR(3,NPT)
  24. ENDSEGMENT
  25. C
  26. NPT=KF(/1)
  27. NSE=NFA(/1)
  28. C WRITE(6,*) ' KSUBCR : NPT NSE KSUB NSUB ',NPT,NSE,KSUB,NSUB
  29.  
  30. C SOMMETS
  31. C -------
  32. DO 320 I = 1,NPT
  33. DO 322 K=1,KES
  34. O2(K) = AA(K,I,KSUB)
  35. 322 CONTINUE
  36.  
  37. CALL KAPCUB(KES,O2,O1,NRES,X1,KF(I),ICOO(1,I),ICOO(2,I))
  38. C WRITE(6,*) KF(I),ICOO(1,I),ICOO(2,I)
  39. C WRITE(6,*) ' XR ',(X1(I1),I1=1,KES)
  40.  
  41. DO 323 K = 1,KES
  42. XR(K,I) = X1(K)
  43. 323 CONTINUE
  44. 320 CONTINUE
  45. C
  46. C ARETES
  47. C ------
  48. DO 330 I = 1,NSE
  49. NP1 = I
  50. NP2 = I + 1
  51. IF(I.EQ.3) NP2 = 1
  52. DO 331 K = 1,KES
  53. X1(K) = XR(K,NP1)
  54. X2(K) = XR(K,NP2)
  55. XG1(K) = AA(K,NP1,KSUB)
  56. XG2(K) = AA(K,NP2,KSUB)
  57. 331 CONTINUE
  58.  
  59. KC1(1) = ICOO(1,NP1)
  60. KC1(2) = ICOO(2,NP1)
  61. KC2(1) = ICOO(1,NP2)
  62. KC2(2) = ICOO(2,NP2)
  63. KF1 = KF(NP1)
  64. KF2 = KF(NP2)
  65. CALL KPROJA(O1,XG1,XG2,X1,KF1,KC1,X2,KF2,KC2
  66. & ,I,SPROJA,SHC3D)
  67.  
  68. 330 CONTINUE
  69. C
  70. C WRITE(6,*) '<KSUBCR : NPT NSE KSUB NSUB ',NPT,NSE,KSUB,NSUB
  71. RETURN
  72. END
  73.  
  74.  
  75.  

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