subroutine ael2(coorr,coefr,prmt,estif,emass,edamp,eload,num)
implicit real*8 (a-h,o-z)
dimension estif(2,2),elump(2),emass(2),
&eload(2)
dimension prmt(*),
& efuna(2),coorr(1,2),coor(1)
common /rael2/ru(2,4),
& cu(2,2)
common /vael2/rctr(1,1),crtr(1,1)
common /dael2/ refc(1,2),gaus(2),
& nnode,ngaus,ndisp,nrefc,ncoor,nvar,
& nvard(1),kdord(1),kvord(2,1)
pe=prmt(1)
pa=prmt(2)
fu=prmt(3)
time=prmt(4)
dt=prmt(5)
imate=prmt(6)+0.5
ielem=prmt(7)+0.5
if (num.eq.1) call ael2i
do 10 i=1,nvar
eload(i)=0.0
do 10 j=1,nvar
estif(i,j)=0.0
10 continue
do 999 igaus=1,ngaus
call ael2t(nnode,nrefc,ncoor,refc(1,igaus),coor,coorr,
& rctr,crtr,det)
x=coor(1)
rx=refc(1,igaus)
iu=(igaus-1)*2+1
if (num.gt.1) goto 2
call ael21(refc(1,igaus),ru(1,iu),rctr,crtr)
2 continue
call shapn(nrefc,ncoor,2,ru(1,iu),cu,crtr,1,2,2)
weigh=det*gaus(igaus)
do 100 i=1, 2
efuna(i) = 0.0
100 continue
do 101 i=1,2
iv=kvord(i,1)
stif=+cu(i,2) 
efuna(iv)=efuna(iv)+stif
101 continue
do 202 iv=1,2
do 201 jv=1,2
stif=+efuna(iv)*efuna(jv)*pe*pa
estif(iv,jv)=estif(iv,jv)+stif*weigh
201 continue
202 continue
do 501 i=1,2
iv=kvord(i,1)
stif=+cu(i,1)*fu
eload(iv)=eload(iv)+stif*weigh
501 continue
999 continue
return
end

subroutine ael2i
implicit real*8 (a-h,o-z)
common /dael2/ refc(1,2),gaus(2),
& nnode,ngaus,ndisp,nrefc,ncoor,nvar,
& nvard(1),kdord(1),kvord(2,1)
ngaus= 2
ndisp= 1
nrefc= 1
ncoor= 1
nvar = 2
nnode= 2
kdord(1)=1
nvard(1)=2
kvord(1,1)=1
kvord(2,1)=2
refc(1,1)=-1.
gaus(1)=1.
refc(1,2)=1.
gaus(2)=1.
end


subroutine ael2t(nnode,nrefc,ncoor,refc,coor,coorr,rc,cr,det)
implicit real*8 (a-h,o-z)
dimension refc(nrefc),rc(ncoor,nrefc),cr(nrefc,ncoor),a(5,10),
* coorr(ncoor,nnode),coor(ncoor)
call tael2(refc,coor,coorr,rc)
n=nrefc
m=n*2
det = 1.0
do 10 i=1,n
do 10 j=1,n
if (i.le.ncoor) a(i,j) = rc(i,j)
if (i.gt.ncoor) a(i,j)=1.0
a(i,n+j)=0.0
if (i.eq.j) a(i,n+i) = 1.0
10 continue
c write(*,*) 'a ='
c do 21 i=1,n
c21 write(*,8) (a(i,j),j=1,m)
do 400 i=1,n
amax = 0.0
l = 0
do 50 j=i,n
c = a(j,i)
if (c.lt.0.0) c = -c
if (c.le.amax) goto 50
amax = c
l = j
50 continue
do 60 k=1,m
c = a(l,k)
a(l,k) = a(i,k)
a(i,k) = c
60 continue
c = a(i,i)
det = c*det
do 100 k=i+1,m
100 a(i,k) = a(i,k)/c
do 300 j=1,n
if (i.eq.j) goto 300
do 200 k=i+1,m
200 a(j,k) = a(j,k)-a(i,k)*a(j,i)
c write(*,*) 'i =',i,' j =',j,' a ='
c do 11 ii=1,n
c11 write(*,8) (a(ii,jj),jj=1,m)
300 continue
400 continue
do 500 i=1,nrefc
do 500 j=1,ncoor
500 cr(i,j) = a(i,n+j)
c write(*,*) 'a ='
c do 22 i=1,n
c22 write(*,8) (a(i,j),j=1,m)
c write(*,*) 'rc ='
c do 24 i=1,ncoor
c24 write(*,8) (rc(i,j),j=1,nrefc)
c write(*,*) 'cr ='
c do 23 i=1,nrefc
c23 write(*,8) (cr(i,j),j=1,ncoor)
c write(*,*) 'det =',det
if (det.lt.0.0) det=-det
c write(*,*) 'det =',det
8 format(1x,6f12.3)
end

subroutine ael21(refc,shpr,rctr,crtr)
implicit real*8 (a-h,o-z)
dimension refc(1),shpr(2,2),rctr(1,1),crtr(1,1)
external fael21
rx=refc(1)
call dshap(fael21,refc,shpr,1,2,1)
return
end

real*8 function fael21(refc,n)
implicit real*8 (a-h,o-z)
common /ccael2/ xa(2)
common /vael2/ rctr(1,1),crtr(1,1)
dimension refc(1)
common /coord/ coor(3),coora(27,3)
x=coor(1)
rx=refc(1)
goto (1,2) n
1 fael21=+(+1.-rx)/2. 
goto 1000
2 fael21=+(+1.+rx)/2. 
goto 1000
1000 return
end

subroutine tael2(refc,coor,coorr,rc)
implicit real*8 (a-h,o-z)
dimension refc(1),coor(1),coorr(1,2),rc(1,1)
common /ccael2/ x(2)
external ftael2
do 100 n=1,2
x(n)=coorr(1,n)
100 continue
rx=refc(1)
call dcoor(ftael2,refc,coor,rc,1,1,1)
return
end

real*8 function ftael2(refc,n)
implicit real*8 (a-h,o-z)
dimension refc(1)
common /ccael2/ x(2)
common /vael2/ rctr(1,1),crtr(1,1)
rx=refc(1)
goto (1) n
1 ftael2=+(+(+1.-rx)/2.)*x(1)+(+(+1.+rx)/2.)*x(2)
goto 1000
1000 return
end

【Close】