Télécharger krcom2.eso

Retour à la liste

Numérotation des lignes :

krcom2
  1. C KRCOM2 SOURCE CHAT 05/01/13 01:06:03 5004
  2. SUBROUTINE KRCOM2 (K1,SP1,SHC2D,SKFAC2,SKBUF2,SKRESO)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C RECOMBINAISON
  7. C -------------
  8. C CONTRIBUTION DUE A UN PATCH DONNE
  9.  
  10. C-----------------------------------------------------------------------
  11. SEGMENT SKRESO
  12. INTEGER KFC,NRES,KES,KIMP
  13. ENDSEGMENT
  14. C KFC : NOMBRE DE FACES H.C
  15. C NRES: RESOLUTION
  16. C KES : DIM ESPACE
  17. C KIMP: IMPRESSION
  18. C-----------------------------------------------------------------------
  19. C-----------------------------------------------------------------------
  20. SEGMENT SHC2D
  21. INTEGER IR(NR),KA(NFC),IM(NFC,NFC)
  22. INTEGER KRO(NFC,NES),KSI(NFC,NES)
  23. REAL*8 V(NES,NR),G(NR)
  24. ENDSEGMENT
  25.  
  26. C DESCRIPTION DU H.C DE PROJECTION
  27. C --------------------------------
  28. C V : DIRECTION UNITAIRE DES CELLULES
  29. C G : FACTEUR DE FORME ASSOCIE
  30. C IR: CORRESPONDANCE
  31. C KRO , KSI : POUR LE CHANGEMENT DE REPERE
  32. C IM : REFERENCE
  33. C NR : RESOLUTION
  34. C NFC : NOMBRE DE FACES
  35. C-----------------------------------------------------------------------
  36. SEGMENT SKFAC2
  37. INTEGER NUK(MS,MFACE),KPATCH(MFACE)
  38. INTEGER NCELL(MFACE)
  39. REAL*8 U(3,MFACE),S(MFACE)
  40. REAL*8 FF1(MFACE)
  41. ENDSEGMENT
  42. SEGMENT IPATCH
  43. REAL*8 GP(MSP,NPATCH),SP(NPATCH)
  44. ENDSEGMENT
  45. C
  46. C DESCRIPTION DES ELEMENTS
  47. C ------------------------
  48. C MFACE : NOMBRE DE FACES
  49. C NUK : CONNECTIVITES
  50. C U : NORMALE UNITAIRE ET EQUATION DU PLAN DE L'ELEMENT
  51. C S : SURFACE
  52. C KVU : VISIBILITE A PRIORI
  53. C FF : FACTEURS DE FORME
  54. C FF1 : TRAVAIL
  55. C NCELL : NOMBRE TOTAL DE CELLULES VUES PAR UN POINT
  56. C KPATCH: POINTEUR SUR IPATCH
  57. C NPATCH: NOMBRE DE POINTS SUR L'ELEMENT (REDECOUPAGE)
  58. C GP : COORDONNEES DES POINTS
  59. C SP : ET SURFACES
  60. C-----------------------------------------------------------------------
  61. SEGMENT SKBUF2
  62. INTEGER NUMF(NFC,NOC,NR),NTYP(NFC,NR)
  63. REAL*8 ZB(NFC,NR),PSC(NFC,NR)
  64. ENDSEGMENT
  65. C
  66. C BUFFER ASSOCIE AU H.C
  67. C ---------------------
  68. C NUMF : INDICE DE LE DERNIERE FACE RENCONTREE
  69. C NTYP : TYPES ASSOCIES
  70. C ZB : PROFONDEUR
  71. C PSC : PRODUIT SCALAIRE (NORMALE.DIRECTION CELLULE)
  72. C-----------------------------------------------------------------------
  73. MFACE = FF1(/1)
  74. DO 400 K = 1,MFACE
  75. FF1(K) = 0.
  76. 400 CONTINUE
  77.  
  78. NC = 0
  79. DO 500 NF = 1,KFC
  80. DO 501 I = 1,NRES
  81.  
  82. NTY = NTYP(NF,I)
  83. IF ( (NTY.NE.0) .AND. (PSC(NF,I).GT.-1.) ) THEN
  84. NC = NC + 1
  85. PROD = PSC(NF,I)*G(I)
  86. DO 100 KT=1,NTY
  87. K = NUMF(NF,KT,I)
  88. FF1(K) = FF1(K) + PROD/NTY
  89. 100 CONTINUE
  90. ENDIF
  91. 501 CONTINUE
  92. 500 CONTINUE
  93. NCELL(K1) = NC
  94.  
  95. CALL UTSOMM(FF1,MFACE,FFT)
  96. IF (KIMP.GE.4) THEN
  97. WRITE(6,1000) K1,SP1,NCELL(K1),FFT
  98. 1000 FORMAT(1X,' K1 ',I4,' SP1 ',E12.5,' NCELL ',I6,' FFT ',F10.5)
  99. ENDIF
  100.  
  101. DO 600 K = 1,MFACE
  102. FF1(K) = SP1 * FF1(K)
  103. 600 CONTINUE
  104. C
  105. RETURN
  106. END
  107.  
  108.  
  109.  
  110.  

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