31 USE ebcs_mod
32
33
34
35#include "implicit_f.inc"
36
37
38
39#include "com08_c.inc"
40
41
42
43 INTEGER LISTE(*),NOD
45 . v(3,*),a(3,*),la(3,nod),reso(3,nod),fv(*)
46 TYPE(t_ebcs_normv), INTENT(IN) :: EBCS
47
48
49
50 INTEGER I,N,IVIMP
52 . c,lcar,alp,alpdt,ax,ay,az,vimp,v0(3),fac
53
54 ivimp=ebcs%ivimp
55 IF(ivimp>0)THEN
56 vimp=ebcs%vimp*fv(ivimp)
57 ELSE
58 vimp=ebcs%vimp
59 ENDIF
60 c=ebcs%c
61 lcar=ebcs%lcar
62 alp=zero
63 IF(lcar>zero)alp=c/lcar
64 alpdt=alp*dt1
65
66 IF(tt==zero)THEN
67 DO i=1,nod
68 n=liste(i)
69 reso(1,i)=a(1,n)
70 reso(2,i)=a(2,n)
71 reso(3,i)=a(3,n)
72 ENDDO
73 ENDIF
74
75 IF(alp>zero)THEN
76 DO i=1,nod
77 n=liste(i)
78
79 ax=reso(1,i)+alpdt*(a(1,n)-reso(1,i))
80 ay=reso(2,i)+alpdt*(a(2,n)-reso(2,i))
81 az=reso(3,i)+alpdt*(a(3,n)-reso(3,i))
82
83 reso(1,i)=ax
84 reso(2,i)=ay
85 reso(3,i)=az
86
87 fac=vimp/sqrt(la(1,i)**2+la(2,i)**2+la(3,i)**2)
88 v0(1)=fac*la(1,i)
89 v0(2)=fac*la(2,i)
90 v0(3)=fac*la(3,i)
91
92 a(1,n)=a(1,n)-ax+alp*(v0(1)-v(1,n))
93 a(2,n)=a(2,n)-ay+alp*(v0(2)-v(2,n))
94 a(3,n)=a(3,n)-az+alp*(v0(3)-v(3,n))
95 ENDDO
96 ELSE
97 DO i=1,nod
98 n=liste(i)
99 fac=vimp/sqrt(la(1,i)**2+la(2,i)**2+la(3,i)**2)
100 v0(1)=fac*la(1,i)
101 v0(2)=fac*la(2,i)
102 v0(3)=fac*la(3,i)
103 a(1,n)=zero
104 a(2,n)=zero
105 a(3,n)=zero
106 v(1,n)=v0(1)
107 v(2,n)=v0(2)
108 v(3,n)=v0(3)
109 ENDDO
110 ENDIF
111 RETURN