[CONTACT]

[ABOUT]

[POLICY]

[ADVERTISE]

atest.f cc piecewise

Found at: ftp.icm.edu.pl:70/packages/netlib/pltmg13/pltmg_source/atest.f

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

		
.


AD:

NEW PAGES:

[ODDNUGGET]

[GOPHER]