1 : C KAPCU1 SOURCE PV 11/03/07 21:17:11 6885 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=DABS(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 = DABS(XA(IES)) 30 : ERR = DABS(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 :
© Cast3M 2003 - All rights reserved.
Disclaimer