36 use element_mod , only : nixc
37
38
39
40#include "implicit_f.inc"
41
42
43
44#include "mvsiz_p.inc"
45#include "param_c.inc"
46
47
48
49 INTEGER JFT, JLT,MAT(*),IXC(NIXC,*)
50 my_real ,
INTENT(IN) :: theaccfact
52 .
area(*), px1(*), px2(*), py1(*), py2(*),
53 . tempnc(*), fphi(mvsiz,4), pm(npropm,*),die(*),
54 . dt1c(*), thk(*),tempel(*)
55
56
57
58 INTEGER I,MX
59 my_real :: ca,cb ,kc ,phix,phiy,a
60
61 mx =mat(jft)
62 ca = pm(75,mx)
63 cb = pm(76,mx)
64
65 DO i=jft,jlt
66
67
68
69 kc = (ca + cb*tempel(i))*dt1c(i)/
max(em20,
area(i))*theaccfact
70 phix = tempnc(ixc(2,i))*px1(i) + tempnc(ixc(3,i))*px2(i) -
71 . tempnc(ixc(4,i))*px1(i) - tempnc(ixc(5,i))*px2(i)
72
73 phiy = tempnc(ixc(2,i))*py1(i) + tempnc(ixc(3,i))*py2
74 . tempnc(ixc(4,i))*py1(i) - tempnc(ixc(5,i))*py2(i)
75
76 phix = kc*phix*thk(i)
77 phiy = kc*phiy*thk(i)
78
79
80
81 a = fourth * die(i)
82 fphi(i,1) = a - (phix*px1(i) + phiy*py1(i))
83 fphi(i,2) = a - (phix*px2(i) + phiy*py2(i))
84 fphi(i,3) = a + (phix*px1(i) + phiy*py1(i))
85 fphi(i,4) = a + (phix*px2(i) + phiy*py2(i))
86 ENDDO
87
88 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)