35
36
37
38#include "implicit_f.inc"
39
40
41
42#include "vect01_c.inc"
43#include "param_c.inc"
44
45
46
47 INTEGER ,INTENT(IN) :: NEL,NUVAR
48 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: aldt
49 my_real ,
DIMENSION(NEL,2) ,
INTENT(IN) :: dir1,dir2
50 my_real,
DIMENSION(NEL) ,
INTENT(IN) :: e1x,e2x,e3x,e1y,e2y,
51 . e3y,e1z,e2z,e3z,x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
52 my_real ,
DIMENSION(NEL,NUVAR) ,
INTENT(OUT) :: uvar
53 my_real ,
DIMENSION(NEL) ,
INTENT(OUT) :: tan_phi
54
55
56
57 INTEGER I
59 . r,s,d1,d2,d11,d12,d21,d22,u1x,u1y,u2x,u2y,det,w1x,w2x,w1y,w2y,
60 . phi,csp,snp,tana,r1,r2,s1,s2,aa,bb,suma,v1,v2,v3,wr,ws
61 my_real ,
DIMENSION(NEL) :: e11,e12,e13,e21,e22,e23
62
63
64 IF (ity == 3) THEN
65
66 DO i=1,nel
67 e11(i)= x2(i)+x3(i)-x1(i)-x4(i)
68 e12(i)= y2(i)+y3(i)-y1(i)-y4(i)
69 e13(i)= z2(i)+z3(i)-z1(i)-z4(i)
70 e21(i)= x3(i)+x4(i)-x1(i)-x2(i)
71 e22(i)= y3(i)+y4(i)-y1(i)-y2(i)
72 e23(i)= z3(i)+z4(i)-z1(i)-z2(i)
73 ENDDO
74 ELSEIF (ity == 7) THEN
75
76 DO i=1,nel
77 e11(i)= x2(i)-x1(i)
78 e12(i)= y2(i)-y1(i)
79 e13(i)= z2(i)-z1(i)
80 e21(i)= x3(i)-x1(i)
81 e22(i)= y3(i)-y1(i)
82 e23(i)= z3(i)-z1(i)
83 ENDDO
84 ENDIF
85
86 DO i=1,nel
87 aa = dir1(i,1)
88 bb = dir1(i,2)
89 v1 = aa*e11(i) + bb*e21(i)
90 v2 = aa*e12(i) + bb*e22(i)
91 v3 = aa*e13(i) + bb*e23(i)
92 wr = v1*e1x(i)+ v2*e1y(i) + v3*e1z(i)
93 ws = v1*e2x(i)+ v2*e2y(i) + v3*e2z(i)
94 suma =
max( sqrt(wr*wr + ws*ws), em20)
95 r1 = wr/suma
96 s1 = ws/suma
97 aa = dir2(i,1)
98 bb = dir2(i,2)
99 v1 = aa*e11(i) + bb*e21(i)
100 v2 = aa*e12(i) + bb*e22(i)
101 v3 = aa*e13(i) + bb*e23(i)
102 wr = v1*e1x(i)+ v2*e1y(i) + v3*e1z(i)
103 ws = v1*e2x(i)+ v2*e2y(i) + v3*e2z(i)
104 suma =
max( sqrt(wr*wr + ws*ws), em20)
105 r2 = wr/suma
106 s2 = ws/suma
107 tana = (r1*r2 + s1*s2) / (r1*s2 - r2*s1)
108
109 uvar(i,1:nuvar) = zero
110 uvar(i,6) = tana
111 tan_phi(i) = tana
112 uvar(i,14) = aldt(i)
113 ENDDO
114
115 RETURN