c*************************** file: atest.f *****************************
c-----------------------------------------------------------------------
c
c piecewise lagrange triangle multi grid package
c
c edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
program atest
cx
use mthdef
implicit real(kind=rknd) (a-h,o-z)
implicit integer(kind=iknd) (i-n)
c
c mode = 1 run in batch mode
c = 0 use web browser interface
c = -1 use terminal window interface
c = -2 mpi slave node
c
integer(kind=iknd), parameter :: mode=0
c
c socket for web browser interface
c
integer(kind=iknd), parameter :: webprt=15000
c
c main array sizes
c
integer(kind=iknd), parameter :: maxv=1500000
integer(kind=iknd), parameter :: maxt=2*maxv
integer(kind=iknd), parameter :: maxb=maxv/8
integer(kind=iknd), parameter :: maxd=maxv
integer(kind=iknd), parameter :: maxpth=128*maxb
integer(kind=iknd), parameter :: maxgf=13
c
c main array declarations
c
integer(kind=iknd), dimension(5,maxt) :: itnode
integer(kind=iknd), dimension(7,maxb) :: ibndry
integer(kind=iknd), dimension(8,maxt) :: itdof
integer(kind=iknd), dimension(6,maxpth) :: ipath
c
real(kind=rknd), dimension(maxv) :: vx,vy
real(kind=rknd), dimension(maxt,2) :: e
real(kind=rknd), dimension(maxd,maxgf) :: gf
real(kind=rknd), dimension(2,maxb) :: sf
c
c common blocks
c
character(len=80) :: sp,su
common /atest1/ip(100),rp(100),sp(100)
common /atest2/iu(100),ru(100),su(100)
common /atest5/idevce,ipane
common /atest6/nproc,myid,mpisw,mpirgn,mpiint,mpiflt
cy
external a1xy,a2xy,fxy,gnxy,gdxy,p1xy,p2xy,qxy,sxy
c
call menu(ip,rp,sp)
c
c initialize the iu, ru and su arrays
c
do i=1,100
iu(i)=0
ru(i)=0.0e0_rknd
su(i)=' '
enddo
c
c storage parameters
c
ip(82)=maxpth
ip(83)=maxt
ip(84)=maxv
ip(85)=maxd
ip(86)=maxb
c
c parameters for atest
c
ip(41)=1
ip(42)=mode
ip(43)=webprt
ip(47)=mpirgn
ip(48)=mpisw
ip(49)=nproc
ip(50)=myid+1
c
call setcom(ip)
c
c initialize input arrays
c
30 call gdata(vx,vy,sf,itnode,ibndry,ip,rp,sp,iu,ru,su,sxy)
ip(41)=0
ip(5)=max(ip(5),1)
call dschek(vx,vy,sf,itnode,ibndry,ip,rp,sp,sxy)
c
c get command (some commands change mpi parameters in ip array)
c
50 ip(48)=mpisw
ip(49)=nproc
ip(50)=myid+1
call menu(ip,rp,sp)
c
c equation solution
c
if(sp(12)(1:6)=='pltmg ') then
call pltmg(vx,vy,sf,itnode,ibndry,itdof,ipath,
+ e,ip,rp,sp,gf,a1xy,a2xy,fxy,gnxy,gdxy,p1xy,p2xy,sxy)
c
c mesh generation
c
else if(sp(12)(1:6)=='trigen') then
call trigen(vx,vy,sf,itnode,ibndry,itdof,ipath,
+ e,ip,rp,sp,iu,ru,su,gf,qxy,sxy)
c
c plot function
c
else if(sp(12)(1:6)=='triplt') then
idevce=ip(68)
ipane=ip(69)
call triplt(vx,vy,sf,itnode,ibndry,itdof,
+ e,ip,rp,sp,gf,qxy,sxy)
c
c graph output data
c
else if(sp(12)(1:6)=='gphplt') then
idevce=ip(68)
ipane=ip(70)
call gphplt(ip,rp,sp)
c
c plot input data
c
else if(sp(12)(1:6)=='inplt ') then
idevce=ip(68)
ipane=ip(71)
call inplt(vx,vy,sf,itnode,ibndry,itdof,
+ ip,rp,sp,sxy)
c
c read file
c
else if(sp(12)(1:6)=='read ') then
call rdwrt(sp(6),1_iknd,vx,vy,sf,ibndry,itnode,
+ itdof,ipath,e,ip,rp,sp,iu,ru,su,gf)
c
c write file
c
else if(sp(12)(1:6)=='write ') then
call rdwrt(sp(6),0_iknd,vx,vy,sf,ibndry,itnode,
+ itdof,ipath,e,ip,rp,sp,iu,ru,su,gf)
c
c user supplied command
c
else if(sp(12)(1:6)=='usrcmd') then
sp(11)='usrcmd: ok'
call usrcmd(vx,vy,sf,itnode,ibndry,ip,rp,sp,iu,ru,su)
if(ip(41)/=0) go to 30
c
c quit
c
else if(sp(12)(1:6)=='quit ') then
stop
endif
go to 50
c
end
.