Télécharger krem2g.eso

Retour à la liste

Numérotation des lignes :

  1. C KREM2G SOURCE CHAT 05/01/13 01:06:13 5004
  2. SUBROUTINE KREM2G(K2,NF1,NF2,NA1,NA2,NA3,C,U2,SHC3D,SKCEL
  3. - ,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 kprojg
  9. C
  10. C CAS DE 2 FACES DIFFERENTES NF1 ET NF2 NON PARALLELES
  11. C ____________________________________________________
  12. C
  13. C CAS 1 DE KEMP2F
  14. C
  15. C
  16. C NF3 = NF1 ( ARETE NA3)
  17. C----------------------------------------------------------------------
  18. DIMENSION U2(1),KG(2),KH(2)
  19.  
  20. -INC TFFOR3D
  21. SEGMENT SKCEL
  22. INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  23. REAL*8 RMAX
  24. ENDSEGMENT
  25. C
  26. C CAS NON PARALLELE
  27. C -----------------
  28. C
  29.  
  30. IF (NFA(NA1).EQ.3) THEN
  31. NF = IFA(3,NA1)
  32. IF (NFA(NA2).EQ.3) THEN
  33. IF (IFA(3,NA2).EQ.NF) THEN
  34. C WRITE(6,*) ' KREMP2F CAS 1 NF ',NF
  35. C
  36. C FACE 1 ARETES 1 2 3
  37. C
  38. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  39. CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  40. CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  41. CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  42. CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  43.  
  44. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  45. CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  46. CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  47. CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  48.  
  49. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  50. CALL KREMPA(K2,KG,NG,NF,NA1,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  51. CALL KREMPA(K2,KG,NG,NF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  52. CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)
  53. ELSE
  54. WRITE(6,*) ' ERREUR KREM2G ',NF,IFA(3,NA2)
  55. ENDIF
  56. ELSE
  57. C WRITE(6,*) ' KREMP2F CAS 2 NF ',NF
  58.  
  59. C
  60. C FACE 1 ARETES 1 2 3
  61. C
  62. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  63. CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  64. CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  65. CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  66. CALL KFINSO(NF2,NF,KA,IM,KH)
  67. KG(1) = ( KG(1)/3 + KH(1) )/2
  68. KG(2) = ( KG(2)/3 + KH(2) )/2
  69. CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  70.  
  71. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  72. CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  73. CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  74. CALL KFINSO(NF,NF1,KA,IM,KH)
  75. KH(1) = ( KG(1)/2 + KH(1) )/2
  76. KH(2) = ( KG(2)/2 + KH(2) )/2
  77. CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  78.  
  79. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  80. CALL KREMPA(K2,KG,NG,NF,NA1,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  81. CALL KFINSO(NF1,NF2,KA,IM,KG)
  82. CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)
  83. ENDIF
  84. ELSE
  85. IF (NFA(NA2).EQ.3) THEN
  86. NF = IFA(3,NA2)
  87. C WRITE(6,*) ' KREMP2F CAS 3 NF ',NF
  88. C
  89. C FACE 1 ARETES 1 2 3
  90. C
  91. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  92. CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  93. CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  94. CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  95. CALL KFINSO(NF2,NF,KA,IM,KH)
  96. KG(1) = ( KG(1)/3 + KH(1) )/2
  97. KG(2) = ( KG(2)/3 + KH(2) )/2
  98. CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  99.  
  100. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  101. CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  102. CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  103. CALL KFINSO(NF,NF1,KA,IM,KH)
  104. KH(1) = ( KG(1)/2 + KH(1) )/2
  105. KH(2) = ( KG(2)/2 + KH(2) )/2
  106. CALL KREMPI(NIN,K2,KH,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  107.  
  108. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  109. CALL KREMPA(K2,KG,NG,NF,NA2,3,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  110. CALL KFINSO(NF1,NF2,KA,IM,KG)
  111. CALL KREMPI(NIN,K2,KG,NG,NF,C,U2,SHC3D,SKCEL,SKBUFF)
  112.  
  113. ELSE
  114. C
  115. C FACE 1 ARETES 1 2 3
  116. C
  117. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  118. CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  119. CALL KREMPA(K2,KG,NG,NF1,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  120. CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  121. CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF)
  122. C
  123. C FACE 2 ARETES 1 2
  124. C
  125.  
  126. CALL KINITB(KBCEL,NRES,NRES,KG,NG)
  127. CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  128. CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)
  129. CALL KREMPI(NIN,K2,KG,NG,NF2,C,U2,SHC3D,SKCEL,SKBUFF)
  130. C
  131. ENDIF
  132. ENDIF
  133.  
  134. RETURN
  135. END
  136.  
  137.  
  138.  

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