Télécharger la plaquette Cast3M


fr en

Télécharger kapcu1.eso

Retour à la liste

Numérotation des lignes : 

kapcu1

  1. C KAPCU1    SOURCE    CB215821  16/04/21    21:17:25     8920
  2.       SUBROUTINE  KAPCU1(NES,X,A,NR,XR,IFACE,KFACE,KAC)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       DIMENSION X(NES),A(NES),XA(3),XR(NES),KFACE(2)
  6. C
  7. C Calcul des facteurs de forme en 3D
  8. C Sp appele par KPROJA
  9. C     CAS DE 2 FACES PARALLELES: DIRECTION KAC
  10. C
  11. C
  12.       NR2 = NR/2
  13.       EPS=1E-5
  14.       XAB = -EPS
  15.       A1 = -1E-10
  16.  
  17.         DO 1  IES = 1,NES
  18.          XA(IES) = X(IES)-A(IES)
  19.          A2=ABS(XA(IES))
  20.          IF(A2.GT.A1) THEN
  21.            A1 = A2
  22.            I = IES
  23.          ENDIF
  24.  1      CONTINUE
  25. C
  26.  
  27.       IF (I.EQ.KAC) THEN
  28.        DO 2 IES = 1,NES
  29.          A2 = ABS(XA(IES))
  30.          ERR = ABS(1.-A2/A1)
  31.          IF (IES.NE.I.AND.ERR.LT.0.01) THEN
  32.          I = IES
  33.          GOTO 3
  34.          ENDIF
  35.  2     CONTINUE
  36.       ENDIF
  37. C
  38.  3    CONTINUE
  39. C
  40.       KS = KSIG(XA(I),EPS)
  41. C
  42.       IF (I.EQ.1) THEN
  43.            XR(2) = XA(2)/A1
  44.            XR(3) = XA(3)/A1
  45.            I1 = 1 + INT(NR2*(1+XR(2)))
  46.            I2 = 1 + INT(NR2*(1+XR(3)))
  47.            KFACE(1) = MIN0(NR,I1)
  48.            KFACE(2) = MIN0(NR,I2)
  49.            IF(KS.EQ.1) THEN
  50.            IFACE= 1
  51.            XR(1) = 1.
  52.            ELSE
  53.            IFACE = 2
  54.            XR(1) = -1.
  55.            ENDIF
  56.            RETURN
  57.       ENDIF
  58.       IF (I.EQ.2) THEN
  59.            XR(1) = XA(1)/A1
  60.            XR(3) = XA(3)/A1
  61.            I1 = 1 + INT(NR2*(1+XR(1)))
  62.            I2 = 1 + INT(NR2*(1+XR(3)))
  63.            KFACE(1) = MIN0(NR,I1)
  64.            KFACE(2) = MIN0(NR,I2)
  65.            IF(KS.EQ.1) THEN
  66.            IFACE    = 3
  67.            XR(2) =  1.
  68.            ELSE
  69.            IFACE    = 4
  70.            XR(2) = -1.
  71.            ENDIF
  72.            RETURN
  73.       ENDIF
  74.       IF (I.EQ.3) THEN
  75.            XR(1) = XA(1)/A1
  76.            XR(2) = XA(2)/A1
  77.            I1 = 1 + INT(NR2*(1+XR(1)))
  78.            I2 = 1 + INT(NR2*(1+XR(2)))
  79.            KFACE(1) = MIN0(NR,I1)
  80.            KFACE(2) = MIN0(NR,I2)
  81.            IF(KS.EQ.1) THEN
  82.            IFACE    = 5
  83.            XR(3) =  1.
  84.            ELSE
  85.            IFACE    = 6
  86.            XR(3) = -1.
  87.            ENDIF
  88.            RETURN
  89.       ENDIF
  90.       END
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  

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