Télécharger la plaquette Cast3M


fr en

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