Télécharger la plaquette Cast3M


fr en

Télécharger krems2.eso

Retour à la liste

Numérotation des lignes : 

krems2

  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