Télécharger kinpr2.eso

Retour à la liste

Numérotation des lignes :

kinpr2
  1. C KINPR2 SOURCE CHAT 05/01/13 00:56:38 5004
  2. SUBROUTINE KINPR2 (U1,SHC2D,SKBUF2,SKRESO)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C DETERMINATION DES CELLULES VUES A PARTIR DE LA DIRECTION U1
  7. C
  8. C-----------------------------------------------------------------------
  9. SEGMENT SKRESO
  10. INTEGER KFC,NRES,KES,KIMP
  11. ENDSEGMENT
  12. C KFC : NOMBRE DE FACES H.C
  13. C NRES: RESOLUTION
  14. C KES : DIM ESPACE
  15. C KIMP: IMPRESSION
  16. C-----------------------------------------------------------------------
  17. C-----------------------------------------------------------------------
  18. SEGMENT SHC2D
  19. INTEGER IR(NR),KA(NFC),IM(NFC,NFC)
  20. INTEGER KRO(NFC,NES),KSI(NFC,NES)
  21. REAL*8 V(NES,NR),G(NR)
  22. ENDSEGMENT
  23.  
  24. C DESCRIPTION DU H.C DE PROJECTION
  25. C --------------------------------
  26. C V : DIRECTION UNITAIRE DES CELLULES
  27. C G : FACTEUR DE FORME ASSOCIE
  28. C IR: CORRESPONDANCE
  29. C KRO , KSI : POUR LE CHANGEMENT DE REPERE
  30. C IM : REFERENCE
  31. C NR : RESOLUTION
  32. C NFC : NOMBRE DE FACES
  33. C-----------------------------------------------------------------------
  34. SEGMENT SKBUF2
  35. INTEGER NUMF(NFC,NOC,NR),NTYP(NFC,NR)
  36. REAL*8 ZB(NFC,NR),PSC(NFC,NR)
  37. ENDSEGMENT
  38. C
  39. C BUFFER ASSOCIE AU H.C
  40. C ---------------------
  41. C NUMF : INDICE DE LE DERNIERE FACE RENCONTREE
  42. C NTYP : TYPES ASSOCIES
  43. C ZB : PROFONDEUR
  44. C PSC : PRODUIT SCALAIRE (NORMALE.DIRECTION CELLULE)
  45. C-----------------------------------------------------------------------
  46. C
  47. DIMENSION U1(1)
  48. C
  49. C
  50. DO 1 NF = 1,KFC
  51. DO 2 I = 1,NRES
  52. B = 0.
  53. DO 4 IES = 1,KES
  54. B = B + U1(IES)*KSI(NF,IES)*V(KRO(NF,IES),I)
  55. 4 CONTINUE
  56. IF (B.GT.0.000001) THEN
  57. PSC(NF,I) = B
  58. ELSE
  59. PSC(NF,I) = -1.
  60. ENDIF
  61. 2 CONTINUE
  62. 1 CONTINUE
  63. RETURN
  64. END
  65.  
  66.  

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