34
35
36
37#include "implicit_f.inc"
38
39
40
41#include "mvsiz_p.inc"
42
43
44
45#include "com01_c.inc"
46#include "param_c.inc"
47
48
49
50 INTEGER NEL
51 INTEGER PID(*)
53 . off(*), rho(*),geo(npropg,*), ssp(*),
54 . aire(*), vol(*), d1(*), d2(*), d3(*),
55 . d4(*), d5(*), d6(*),sv1(*), sv2(*), sv3(*),
56 . sv4(*), sv5(*), sv6(*),s3(*),e3(*),rho0(*),rhoref(*)
57
58
59
60 INTEGER I
62 . dd(mvsiz), al(mvsiz), nrho(mvsiz), cns1, cns2, cns3, dav, pvis
63
64 dd(1:nel)=-d1(1:nel)-d2(1:nel)-d3(1:nel)
65
66 IF(n2d > 0) THEN
67 DO i=1,nel
68 al(i)=zero
69 IF(off(i) >= one)al(i)=sqrt(aire(i))
70 ENDDO
71 ELSE
72 DO i=1,nel
73 al(i)=zero
74 IF(off(i) >= one) al(i)=exp(third*log
75 ENDDO
76 ENDIF
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93 DO i=1,nel
94 nrho(i) = sqrt(rhoref(i)*rho0(i))
95 ENDDO
96
97 IF(geo(16,pid(1)) >= zero)THEN
98 DO i=1,nel
99 cns1=geo(16,pid(1))*al(i)*nrho(i)*ssp(i)*off(i)
100 cns2=geo(17,pid(1))*al(i)*nrho(i)*ssp(i)*off(i)
101 cns3=half*cns2
102 dav=dd(i) * third
103 pvis=-cns1*dd(i)
104 sv1(i)= sv1(i) + cns2 *(d1(i)+dav)+pvis
105 sv2(i)= sv2(i) + cns2 *(d2(i)+dav)+pvis
106 sv3(i)= sv3(i) + cns2 *(d3(i)+dav)+pvis
107 sv4(i)= sv4(i) + cns3 * d4(i)
108 sv5(i)= sv5(i) + cns3 * d5(i)
109 sv6(i)= sv6(i) + cns3 * d6(i)
110
111 ENDDO
112 ELSE
113 DO i=1,nel
114 cns1=geo(16,pid
115 cns2=geo(17,pid(1))*nrho(i)*ssp(i)**2*off(i)
116 cns3=half*cns2
117 dav=dd(i) * third
118 pvis=-cns1*dd(i)
119 sv1(i)= sv1(i) + cns2 *(d1(i)+dav)+pvis
120 sv2(i)= sv2(i) + cns2 *(d2(i)+dav)+pvis
121 sv3(i)= sv3(i) + cns2 *(d3(i)+dav)+pvis
122 sv4(i)= sv4(i) + cns3 * d4(i)
123 sv5(i)= sv5(i) + cns3 * d5(i)
124 sv6(i)= sv6(i) + cns3 * d6(i)
125
126 ENDDO
127 END IF
128
129 RETURN