Télécharger krems2.eso

Retour à la liste

Numérotation des lignes :

  1. C KREMS2 SOURCE CB215821 16/04/21 21:17:37 8920
  2. SUBROUTINE KREMS2 (K2,NF,I,C,U2,SHC2D,SKBUF2,SKRESO)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C CELLULES-SOMMETS
  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. DIMENSION U2(1),KG(2)
  47. C
  48. NOC = NUMF(/2)
  49. C
  50. IF (PSC(NF,I).GT.-1.) THEN
  51. B = 0.
  52. DO 40 IES = 1,KES
  53. B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I)
  54. 40 CONTINUE
  55. IF (ABS(B).GT.0.0001) THEN
  56. Z = - C / B
  57. DFF = Z - ZB(NF,I)
  58. DIFF = ABS(DFF)
  59. NTY = NTYP(NF,I)
  60. IF (DIFF.LT.1E-4.AND.NTY.LT.NOC) THEN
  61. DO 100 KT=1,NTY
  62. K = NUMF(NF,KT,I)
  63. IF (K.EQ.K2) GOTO 101
  64. 100 CONTINUE
  65. NTY = NTY + 1
  66. NUMF(NF,NTY,I) = K2
  67. NTYP(NF,I) = NTY
  68. 101 CONTINUE
  69. ELSE
  70. IF (DFF.LT.-1E-3.AND.Z.GT.1E-4) THEN
  71. ZB(NF,I) = Z
  72. NUMF(NF,1,I) = K2
  73. NTYP(NF,I) = 1
  74. ENDIF
  75. ENDIF
  76. ENDIF
  77. ENDIF
  78.  
  79. RETURN
  80. END
  81.  
  82.  
  83.  
  84.  

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