Télécharger la plaquette Cast3M


fr en

Télécharger krempa.eso

Retour à la liste

Numérotation des lignes : 

krempa

  1. C KREMPA    SOURCE    PV        22/04/21    21:15:07     11344          
  2.       SUBROUTINE KREMPA (K2,KG,NG,NF,NA,NAL,C,U2,
  3.      -         SHC3D,SKCEL,SPROJA,SKBUFF)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       DIMENSION U2(*),KG(2)
  7. C----------------------------------------------------------------------
  8. C Calcul des facteurs de forme en 3D
  9. C Sp appele par la famille KREMxG
  10. C
  11. C     CELLULES-ARETES
  12. C     ---------------
  13. C
  14. C     DETERMINATION DES CELLULES SITUEES SUR LA FACE 'NF' APPARTENANT
  15. C     A LA PROJECTION DE L'ARETE 'NA' DE L'ELEMENT 'K2'
  16. C
  17. C     NA  : INDICE DE L'ARETE
  18. C     U2  : NORMALE DE L'ELEMENT K2
  19. C
  20. C      NAL : INDICE DU NUMERO DE FACE DANS L'ARETE 1,2 OU 3
  21. C            SI 3  ON CALCULE NF
  22. C
  23. C      SI NFA = 3 : SEUL CAS OU ON CALCULE NF
  24. C----------------------------------------------------------------------
  25.  
  26. -INC TFFOR3D
  27.       SEGMENT SKCEL
  28.       INTEGER  KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)
  29.       REAL*8   RMAX
  30.       ENDSEGMENT
  31. C
  32.         IF(NAL.NE.3) THEN
  33.  
  34.                IF(NF.EQ.IFA(NAL,NA)) THEN
  35.                   LF = 1
  36.                ELSE
  37.                   LF = 2
  38.                ENDIF
  39.         ELSE
  40.            IF (NFA(NA).EQ.3) THEN
  41.                LF = 3
  42.                NF = IFA(3,NA)
  43.            ELSE
  44.                IF (IFA(3,NA).EQ.NF) THEN
  45.                    LF = 3
  46.                ELSE
  47.                    LF = 4
  48.                ENDIF
  49.            ENDIF
  50.         ENDIF
  51. C
  52.         KG(1) = KG(1) + IG(LF,1,NA)
  53.         KG(2) = KG(2) + IG(LF,2,NA)
  54.         NG = NG + 1
  55. C
  56.         NOC = NUMF(/2)
  57.         DO 403 KC = 1,NCEL(LF,NA)
  58.             I = ICEL(LF,1,KC,NA)
  59.             J = ICEL(LF,2,KC,NA)
  60.             KBCEL(I,J) = 1
  61. C
  62.  
  63.          IF (PSC(NF,I,J).GT.-1.) THEN
  64.             B = 0.
  65.             DO 40   IES = 1,KES
  66.             B = B + U2(IES)*KSI(NF,IES)*V(KRO(NF,IES),I,J)
  67.  40         CONTINUE
  68. C
  69. C           CELLULE SOMMET OU ARETE
  70. C
  71.             IF (ABS(B).GT.0.0001) THEN
  72.                Z = -  C / B
  73.                DFF = Z - ZB(NF,I,J)
  74.                DIFF = ABS(DFF)
  75.                NTY = NTYP(NF,I,J)
  76.                IF (DIFF.LT.1E-4.AND.NTY.LT.NOC) THEN
  77.                  DO 100 KT=1,NTY
  78.                  K = NUMF(NF,KT,I,J)
  79.                  IF (K.EQ.K2) GOTO 101
  80.  100             CONTINUE
  81.                   NTY = NTY + 1
  82.                   NUMF(NF,NTY,I,J) = K2
  83.                   NTYP(NF,I,J) = NTY
  84.  101             CONTINUE
  85.                ELSE
  86.                    IF (DFF.LT.-1E-3.AND.Z.GT.1E-4)  THEN
  87.                        ZB(NF,I,J) = Z
  88.                        NUMF(NF,1,I,J) = K2
  89.                        NTYP(NF,I,J) = 1
  90.                     ENDIF
  91.                ENDIF
  92.             ENDIF
  93.          ENDIF
  94.  403  CONTINUE
  95.  
  96.       RETURN
  97.       END
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  

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