Télécharger krempi.eso

Retour à la liste

Numérotation des lignes :

krempi
  1. C KREMPI SOURCE CB215821 16/04/21 21:17:36 8920
  2. SUBROUTINE KREMPI (NINS,K2,KG,NARL,NF,C,U2,SHC3D,SKCEL,SKBUFF)
  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 la famille KREMxG
  8. C
  9. C DETERMINATION DE l'INTERIEUR D'UN CONTOUR
  10. C----------------------------------------------------------------------
  11. DIMENSION KG(2),U2(1)
  12. -INC TFFOR3D
  13. SEGMENT SKCEL
  14. INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  15. REAL*8 RMAX
  16. ENDSEGMENT
  17. C
  18. NRMAX = NINT(RMAX * IINT(/2))
  19. NSTAC = IS(/1)
  20. IF(NARL.EQ.3) THEN
  21. KG(1) = (KG(1)+1) /NARL
  22. KG(2) = (KG(2)+1) /NARL
  23. ELSE
  24. KG(1) = KG(1) /NARL
  25. KG(2) = KG(2) /NARL
  26. ENDIF
  27.  
  28. IF( KBCEL(KG(1),KG(2)).EQ.0) THEN
  29. CALL KPARC(KG,KBCEL,NRES,NINS,IINT,NRMAX,IS,JS,NSTAC)
  30. IF(NINS.EQ.NRMAX) THEN
  31. NINS = 0
  32. IF (KIMP.GE.4) THEN
  33. WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),'NINS ',NINS,' EXTERIEUR '
  34. ENDIF
  35. ELSE
  36. IF (KIMP.GE.4) THEN
  37. WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),'NINS ',NINS
  38. ENDIF
  39. ENDIF
  40.  
  41. ELSE
  42. NINS = 0
  43. IF (KIMP.GE.4) THEN
  44. WRITE(6,*) ' NF KG ',NF,KG(1),KG(2),' NINS ',NINS,' CONTOUR '
  45. ENDIF
  46. ENDIF
  47.  
  48. IF (KIMP.GE.4) THEN
  49. DO 2 I = 1,NRES
  50. WRITE(6,*) (KBCEL(I,J),J=1,NRES)
  51. 2 CONTINUE
  52. ENDIF
  53.  
  54. IF (NINS.NE.0) THEN
  55. DO 404 L = 1,NINS
  56. I = IINT(1,L)
  57. J = IINT(2,L)
  58. IF (PSC(NF,I,J).GT.-1.) THEN
  59. B = 0.
  60. DO 406 IES = 1,KES
  61. B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I,J)
  62. 406 CONTINUE
  63. IF (ABS(B).GT.0.0001) THEN
  64. Z = - C / B
  65. IF (Z.LT.ZB(NF,I,J).AND.Z.GT.1E-4) THEN
  66. ZB(NF,I,J) = Z
  67. NUMF(NF,1,I,J) = K2
  68. NTYP(NF,I,J) = 1
  69. ENDIF
  70. ENDIF
  71. ENDIF
  72. 404 CONTINUE
  73. ENDIF
  74. RETURN
  75. END
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  

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