Télécharger krem3f.eso

Retour à la liste

Numérotation des lignes :

  1. C KREM3F SOURCE CHAT 05/01/13 01:06:16 5004
  2. SUBROUTINE KREM3F(K2,KG,NG,KC1,NA2,NF2,NF3,NF1,NA3,NA1
  3. - ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  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 krem3g
  9. C 3 FACES DIFFERENTES NON PARALLELES
  10. C ----------------------------------
  11. C
  12. C IL EXISTE UNE FACE GENEREE PAR L'ARETE NA2
  13. C -------------------------------------------
  14. C
  15. C----------------------------------------------------------------------
  16. DIMENSION KG(2),KH(2),KC1(2)
  17. -INC TFFOR3D
  18.  
  19. SEGMENT SKCEL
  20. INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  21. REAL*8 RMAX
  22. ENDSEGMENT
  23. IF (IFA(3,NA2).EQ.NF1) THEN
  24.  
  25. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  26. CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  27. CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  28. CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  29.  
  30. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  31. CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  32. CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  33. CALL KREMPI(NIN,K2,KG,NG,NF3,C,U2,SHC3D,SKCEL,SKBUFF)
  34.  
  35. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  36. CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  37. CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  38. KH(1) = (KG(1)/2 + KC1(1))/2
  39. KH(2) = (KG(2)/2 + KC1(2))/2
  40. NG = 0
  41. KG(1) = 0
  42. KG(2) = 0
  43. CALL KREMPA(K2,KG,NG,NFN,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  44. KH(1) = (KG(1) + KH(1))/2
  45. KH(2) = (KG(2) + KH(2))/2
  46. CALL KREMPI(NIN,K2,KH,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  47.  
  48. ELSE
  49. NFF = IFA(3,NA2)
  50.  
  51. C WRITE(6,*) ' KREMPY NFF ',NFF
  52. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  53. CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  54. CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  55. CALL KFINSO(NF1,NF3,KA,IM,KH)
  56. CALL KFINSO(NFF,NF3,KA,IM,KG)
  57. KH(1) = (KG(1) + KH(1))/2
  58. KH(2) = (KG(2) + KH(2))/2
  59. CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  60.  
  61. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  62. CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  63. CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  64. CALL KFINSO(NF1,NF2,KA,IM,KH)
  65. CALL KFINSO(NFF,NF2,KA,IM,KG)
  66. KH(1) = (KG(1) + KH(1))/2
  67. KH(2) = (KG(2) + KH(2))/2
  68. CALL KREMPI(NIN,K2,KH,1,NF3,C,U2,SHC3D,SKCEL,SKBUFF)
  69.  
  70. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  71. CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  72. CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  73. CALL KFINSO(NF2,NF3,KA,IM,KH)
  74. KH(1) = (KG(1)/2 + KH(1))/2
  75. KH(2) = (KG(2)/2 + KH(2))/2
  76. CALL KREMPI(NIN,K2,KH,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  77. C
  78. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  79. CALL KREMPA(K2,KG,NG,NFF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  80. CALL KFINSO(NF2,NF3,KA,IM,KG)
  81. CALL KREMPI(NIN,K2,KG,1,NFF,C,U2,SHC3D,SKCEL,SKBUFF)
  82. ENDIF
  83.  
  84. RETURN
  85. END
  86.  
  87.  
  88.  

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