c*********************** problem name: control *********************** c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine a1xy(x,y,u,ux,uy,rl,itag,values) c implicit real (a-h,o-z) implicit integer (i-n) c real + values(*) character*80 + su common /val0/k0,ku,kx,ky,kl,kuu,kux,kuy,kul, + kxu,kxx,kxy,kxl,kyu,kyx,kyy,kyl,klu,klx,kly,kll c values(k0)=ux values(kx)=1.0e0 return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine a2xy(x,y,u,ux,uy,rl,itag,values) c implicit real (a-h,o-z) implicit integer (i-n) c real + values(*) character*80 + su common /val0/k0,ku,kx,ky,kl,kuu,kux,kuy,kul, + kxu,kxx,kxy,kxl,kyu,kyx,kyy,kyl,klu,klx,kly,kll c values(k0)=uy values(ky)=1.0e0 return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine fxy(x,y,u,ux,uy,rl,itag,values) c implicit real (a-h,o-z) implicit integer (i-n) c real + values(*) character*80 + su common /atest2/ix,iy,iu(98),gamma,beta,f0,f1,f2,f3, + c0,c1,c2,c3,bdlw,bdup,dbc,ru(87),su(100) common /val0/k0,ku,kx,ky,kl,kuu,kux,kuy,kul, + kxu,kxx,kxy,kxl,kyu,kyx,kyy,kyl,klu,klx,kly,kll c q=((f3*u+f2)*u+f1)*u+f0 qu=(3.0e0*f3*u+2.0e0*f2)*u+f1 quu=6.0e0*f3*u+2.0e0*f2 p=((c3*u+c2)*u+c1)*u+c0 pu=(3.0e0*c3*u+2.0e0*c2)*u+c1 puu=6.0e0*c3*u+2.0e0*c2 values(k0)=-q-rl*p values(kl)=-p values(ku)=-qu-rl*pu values(kul)=-pu values(kuu)=-quu-rl*puu return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine gnxy(x,y,u,rl,itag,values) c implicit real (a-h,o-z) implicit integer (i-n) c real + values(*) character*80 + su common /val1/k0,ku,kl,kuu,kul,klu,kll c return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine gdxy(x,y,rl,itag,values) c implicit real (a-h,o-z) implicit integer (i-n) c real + values(*) character*80 + su common /val2/k0,kl,kll,klb,kub,kic,kim,kil common /atest2/ix,iy,iu(98),gamma,beta,f0,f1,f2,f3, + c0,c1,c2,c3,bdlw,bdup,dbc,ru(87),su(100) c values(k0)=dbc values(klb)=bdlw values(kub)=bdup values(kil)=(bdlw+bdup)/2.0e0 return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine p1xy(x,y,u,ux,uy,rl,itag,values) c implicit real (a-h,o-z) implicit integer (i-n) c real + values(*) character*80 + su common /val0/k0,ku,kx,ky,kl,kuu,kux,kuy,kul, + kxu,kxx,kxy,kxl,kyu,kyx,kyy,kyl,klu,klx,kly,kll common /atest2/ix,iy,iu(98),gamma,beta,f0,f1,f2,f3, + c0,c1,c2,c3,bdlw,bdup,dbc,ru(87),su(100) c call uexact(x,y,itag,r,rx,ry,rxx,ryy,rxy) values(k0)=(u-r)**2+beta*((ux-rx)**2+(uy-ry)**2)+gamma*rl**2 values(ku)=2.0e0*(u-r) values(kx)=2.0e0*(ux-rx)*beta values(ky)=2.0e0*(uy-ry)*beta values(kl)=2.0e0*gamma*rl values(kuu)=2.0e0 values(kxx)=2.0e0*beta values(kyy)=2.0e0*beta values(kll)=2.0e0*gamma return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine p2xy(x,y,dx,dy,u,ux,uy,rl,itag,jtag,values) c implicit real (a-h,o-z) implicit integer (i-n) c real + values(*) character*80 + su common /val0/k0,ku,kx,ky,kl,kuu,kux,kuy,kul, + kxu,kxx,kxy,kxl,kyu,kyx,kyy,kyl,klu,klx,kly,kll common /atest2/ix,iy,iu(98),gamma,beta,f0,f1,f2,f3, + c0,c1,c2,c3,bdlw,bdup,dbc,ru(87),su(100) c return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine qxy(x,y,u,ux,uy,rl,itag,values) c implicit real (a-h,o-z) implicit integer (i-n) c real + values(*) common /val3/kf,kf1,kf2,ksk,kad c call uexact(x,y,itag,r,rx,ry,rxx,ryy,rxy) values(kf)=r values(kf1)=rx values(kf2)=ry return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine uexact(x,y,itag,u,ux,uy,uxx,uyy,uxy) c implicit real (a-h,o-z) implicit integer (i-n) character*80 + su common /atest2/ix,iy,iu(98),gamma,beta,f0,f1,f2,f3, + c0,c1,c2,c3,bdlw,bdup,dbc,ru(87),su(100) c pi=3.141592653589793e0 ax=float(ix)*pi ay=float(iy)*pi sx=sin(ax*x) sy=sin(ay*y) cx=cos(ax*x) cy=cos(ay*y) u=sx*sy+dbc ux=ax*cx*sy uy=ay*sx*cy uxx=-ax**2*u uyy=-ay**2*u uxy=ax*ay*cx*cy return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine usrcmd(vx,vy,xm,ym,itnode,ibndry,ip,rp,sp,iu,ru,su,w) c implicit real (a-h,o-z) implicit integer (i-n) integer + itnode(5,*),ibndry(6,*),ip(100),iu(100) real + vx(*),vy(*),xm(*),ym(*),rp(100),ru(100),w(*) character*80 + sp(100),su(100),file(30) save len,file c data len/15/ data (file(i),i= 1, 10)/ + 'n i= 1,n=ix, a=ix,t=i', 1 'n i= 2,n=iy, a=iy,t=i', 2 'n i= 1,n=gamma, a=g ,t=r', 3 'n i= 2,n=beta, a=b ,t=r', 4 'n i= 3,n=f0 ,a=f0,t=r', 5 'n i= 4,n=f1 ,a=f1,t=r', 6 'n i= 5,n=f2 ,a=f2,t=r', 7 'n i= 6,n=f3 ,a=f3,t=r', 8 'n i= 7,n=c0 ,a=c0,t=r', 9 'n i= 8,n=c1 ,a=c1,t=r'/ data (file(i),i= 11, 15)/ + 'n i= 9,n=c2 ,a=c2,t=r', 1 'n i=10,n=c3 ,a=c3,t=r', 2 'n i=11,n=bdlw, a=bl,t=r', 3 'n i=12,n=bdup, a=bu,t=r', 4 'n i=13,n=dbc, a=bc,t=r'/ c c enter input mode c call usrset(file,len,iu,ru,su) return end c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 10.0 - - - september, 2007 c c----------------------------------------------------------------------- subroutine gdata(vx,vy,xm,ym,itnode,ibndry,ip,rp,sp,iu,ru,su,w) c implicit real (a-h,o-z) implicit integer (i-n) integer + itnode(5,*),ibndry(6,*),ip(100),iu(100) real + vx(*),vy(*),xm(*),ym(*),rp(100),ru(100), 1 w(*),x(9),y(9) character*80 + sp(100),su(100) save x,y,ntf,nvf,ncf,nbf,ispd c data x/0.e0,0.e0,.5e0,1.e0,1.e0,1.e0,.5e0,0.e0,.5e0/ data y/.5e0,1.e0,1.e0,1.e0,.5e0,0.e0,0.e0,0.e0,.5e0/ data ntf,nvf,ncf,nbf,ispd/8,9,0,8,1/ c c common /atest2/ix,iy,iu(98),gamma,beta,f0,f1,f2,f3, c + c0,c1,c2,c3,bdlw,bdup,dbc,ru(87),su(100) c c if(ip(41).eq.1) then sp(2)='control' sp(1)='control' sp(3)='control' sp(4)='control' sp(6)='control_mpixxx.rw' sp(7)='control.jnl' sp(9)='control_mpixxx.out' iu(1)=5 iu(2)=5 ru(1)=1.0e-4 ru(2)=0.0e0 ru(3)=0.0e0 ru(4)=0.0e0 ru(5)=0.0e0 ru(6)=0.0e0 ru(7)=1.0e0 ru(8)=0.0e0 ru(9)=0.0e0 ru(10)=0.0e0 ru(11)=1.0e0 ru(12)=10.0e0 ru(13)=1.0e0 endif c ip(1)=ntf ip(2)=nvf ip(3)=ncf ip(4)=nbf ip(6)=max0(ip(6),ip(26),1) ip(7)=5 ip(8)=ispd ip(9)=0 rp(3)=0.1e0 c** ip(20)=4 ip(21)=4 c** do i=1,ntf itnode(1,i)=9 itnode(2,i)=i itnode(3,i)=i-1 itnode(4,i)=0 itnode(5,i)=i c ibndry(1,i)=i ibndry(2,i)=i-1 ibndry(3,i)=0 ibndry(4,i)=2 ibndry(5,i)=0 ibndry(6,i)=(i+1)/2 enddo itnode(3,1)=8 ibndry(2,1)=8 c do i=1,nvf vx(i)=x(i) vy(i)=y(i) enddo c return end