c*************************** file: atest.f ***************************** c----------------------------------------------------------------------- c c piecewise lagrange triangle multi grid package c c edition 11.0 - - - june, 2012 c c----------------------------------------------------------------------- program atest c c storage allocation cx use mthdef implicit real(kind=rknd) (a-h,o-z) implicit integer(kind=iknd) (i-n) 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 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 real(kind=rknd), dimension(maxv) :: vx,vy real(kind=rknd), dimension(maxt,2) :: e real(kind=rknd), dimension(maxd,7) :: gf real(kind=rknd), dimension(2,maxb) :: sf character(len=80) :: sp,su common /atest1/ip(100),rp(100),sp(100) common /atest2/iu(100),ru(100),su(100) common /atest5/idevce common /atest6/nproc,myid,mpisw,mpiint,mpiflt cy external a1xy,a2xy,fxy,gnxy,gdxy,p1xy,p2xy,qxy,sxy c c mode = 1 run in batch mode c = 0 use x-windows interface c = -1 use terminal window interface c = -2 mpi slave node c call menu(ip,rp,sp) mode=0 ngraph=0 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 call setcom 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)=ngraph ip(48)=mpisw ip(49)=nproc ip(50)=myid+1 sp(21)='localhost' 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(44) 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(45) call gphplt(ip,rp,sp) c c plot input data c else if(sp(12)(1:6)=='inplt ') then idevce=ip(46) call inplt(vx,vy,sf,itnode,ibndry,itdof, + e,ip,rp,sp,sxy) c c read file c else if(sp(12)(1:6)=='read ') then if(mpisw==1) then mpirgn=ip(47) if(mpirgn/=0.and.mpirgn/=myid+1) go to 50 endif 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 if(mpisw==1) then mpirgn=ip(47) if(mpirgn/=0.and.mpirgn/=myid+1) go to 50 endif 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 shell c else if(sp(12)(1:6)=='shell ') then call cshex(sp(5)) c c quit c else if(sp(12)(1:6)=='quit ') then stop endif go to 50 c end .