35
36
37
38
39#include "implicit_f.inc"
40
41
42
43#include "mvsiz_p.inc"
44
45
46
47#include "com01_c.inc"
48#include "param_c.inc"
49
50
51
52 INTEGER, INTENT(IN) :: NEL
53
55 . pm(npropm,*), off(*), rho(*),geo(npropg,*), ssp(*),
56 . aire(*), vol(*), d1(*), d2(*), d3(*),
57 . d4(*), d5(*), d6(*), rhoref(*)
58 my_real,
DIMENSION(MVSIZ,6),
INTENT(INOUT) :: svis
59 INTEGER PID(*), MAT(*),ISVIS
60
61
62
63 INTEGER I, MT
64
66 . dd(mvsiz), al(mvsiz), cns1, cns2, cns3,
67 . dav, pvis, rho0(mvsiz), nrho(mvsiz)
68
69 IF (isvis==0) RETURN
70 DO 10 i=1,nel
71 10 dd(i)=-d1(i)-d2(i)-d3(i)
72
73 DO 20 i=1,nel
74 al(i)=zero
75 IF(off(i)<one) GO TO 20
76 IF(n2d>0) THEN
77 al(i)=sqrt(aire(i))
78 ELSE
79 al(i)=exp(third*log(vol(i)))
80 END IF
81 20 CONTINUE
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98 mt = mat(1)
99 DO i=1,nel
100 rho0(i) = pm(1,mt)
101 nrho(i) = sqrt(rhoref(i)*rho0(i))
102 ENDDO
103
104 IF(geo(16,pid(1)) >= zero)THEN
105 DO i=1,nel
106 cns1=geo(16,pid(1))*al(i)*nrho(i)*ssp(i)*off(i)
107 cns2=geo(17,pid(1))*al(i)*nrho(i)*ssp(i)*off(i)
108 cns3=half*cns2
109 dav=dd(i) * third
110 pvis=-cns1*dd(i)
111 svis(i,1)=cns2 *(d1(i)+dav) + pvis
112 svis(i,2)=cns2 *(d2(i)+dav) + pvis
113 svis(i,3)=cns2 *(d3(i)+dav) + pvis
114 svis(i,4)=cns3 * d4(i)
115 svis(i,5)=cns3 * d5(i)
116 svis(i,6)=cns3 * d6(i)
117
118 ENDDO
119 ELSE
120 DO i=1,nel
121 cns1=abs(geo(16,pid(1)))*nrho(i)*ssp(i)**2*off(i)
122 cns2=abs(geo(17,pid(1)))*nrho(i)*ssp(i)**2*off(i)
123 cns3=half*cns2
124 dav=dd(i) * third
125 pvis=-cns1*dd(i)
126 svis(i,1)=cns2 *(d1(i)+dav) + pvis
127 svis(i,2)=cns2 *(d2(i)+dav) + pvis
128 svis(i,3)=cns2 *(d3(i)+dav) + pvis
129 svis(i,4)=cns3 * d4(i)
130 svis(i,5)=cns3 * d5(i)
131 svis(i,6)=cns3 * d6(i)
132
133 ENDDO
134 END IF
135
136 RETURN