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