Civil Engineering Reference
In-Depth Information
nye=nels/nxe/nze; nr=(nxe+1)*(nye+1)+(nxe+1)*nze+nye*nze; ielpe=iel_start
ALLOCATE (rest(nr,nodof+1),points(nip,ndim),weights(nip),kay(ndim,ndim),&
coord(nod,ndim),fun(nod),jac(ndim,ndim),der(ndim,nod),g(ntot),&
p_g_co_pp(nod,ndim,nels_pp),deriv(ndim,nod), pm(ntot,ntot),
&
g_num_pp(nod,nels_pp),kc(ntot,ntot),funny(1,nod),num(nod),
&
g_g_pp(ntot,nels_pp),storka_pp(ntot,ntot,nels_pp),
&
utemp_pp(ntot,nels_pp),storkb_pp(ntot,ntot,nels_pp),
&
pmul_pp(ntot,nels_pp),diag_precon_tmp(ntot,nels_pp))
kay=0.0_iwp ; kay(1,1) = kx; kay(2,2) = ky ; kay(3,3) = kz
CALL sample (element,points,weights) ; CALL box_bc8(nxe,nye,nze,rest)
CALL rearrange_2(rest)
!-------------loop the elements to set up global arrays -----------------
elements_1: DO iel=1,nels_pp
CALL geometry_8bxz(ielpe,nxe,nze,aa,bb,cc,coord,num)
CALL find_g4(num,g,rest) ; g_num_pp(:,iel) = num
p_g_co_pp(:,:,iel) = coord; g_g_pp(:,iel)=g; ielpe=ielpe+1
i = MAXVAL(g); j = MAXVAL(num)
IF(i>neq_temp)neq_temp = i; IF(j>nn_temp)nn_temp = j
END DO elements_1
neq = reduce(neq_temp) ; nn = reduce(nn_temp) ; nres = nxe*(nze-1) + 1
CALL calc_neq_pp ; CALL make_ggl(g_g_pp)
DO i = 1, neq_pp; IF(nres==ieq_start+i-1) THEN;it=numpe;is = i; END IF
END DO
IF(numpe==it) THEN
OPEN (11,FILE='p124.res',STATUS='REPLACE',ACTION='WRITE')
WRITE(11,'(A,I5,A)') "This job ran on ", npes, " processors"
WRITE(11,'(A)') "Global coordinates and node numbers "
DO i= 1, nels_pp , nels_pp - 1
WRITE(11,'(A,I8)')"Element ",i ; num = g_num_pp(:,i)
DO k = 1,nod;WRITE(11,'(A,I8,3E12.4)')
&
" Node",num(k),p_g_co_pp(k,:,i); END DO
END DO
WRITE(11,'(A,3(I8,A))')"There are ",nn," nodes",nr," restrained and",&
neq," equations"
WRITE(11,*) "Time after setup is
:", elap_time( ) - timest(1)
END IF
ALLOCATE(loads_pp(neq_pp),diag_precon_pp(neq_pp),u_pp(neq_pp),
&
d_pp(neq_pp),p_pp(neq_pp),x_pp(neq_pp),xnew_pp(neq_pp))
storka_pp = .0_iwp; storkb_pp = .0_iwp;diag_precon_tmp = .0_iwp
p_pp = .0_iwp; diag_precon_pp = .0_iwp; xnew_pp = .0_iwp
!----------- element integration ,storage and build preconditioner --------
elements_2: DO iel=1,nels_pp
num = g_num_pp( : , iel); g = g_g_pp( :, iel)
coord = p_g_co_pp( : , : , iel) ; kc=0.0_iwp ; pm=0.0_iwp
gauss_pts: DO i =1 , nip
CALL shape_der (der,points,i); CALL shape_fun(fun,points,i)
funny(1,:)=fun(:) ; jac = MATMUL(der,coord)
det=determinant(jac);CALL invert(jac);deriv=MATMUL(jac,der)
kc = kc + MATMUL(MATMUL(TRANSPOSE(deriv),kay),deriv)
&
*det*weights(i)
pm = pm + MATMUL(TRANSPOSE(funny),funny)*det*weights(i)
END DO gauss_pts
storka_pp(:,:,iel)=pm+kc*theta*dtim
storkb_pp(:,:,iel)=pm-kc*(1._iwp-theta)*dtim
DO k=1,ntot
diag_precon_tmp(k,iel)=diag_precon_tmp(k,iel)+ storka_pp(k,k,iel)
END DO
END DO elements_2
