[CONTACT]

[ABOUT]

[POLICY]

[ADVERTISE]

problem ident cc piecewise

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

c***********************  problem name: ident  *************************
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine a1xy(x,y,u,ux,uy,rl,itag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: values,rl(*)
            character(len=80) :: su
            common /val0/k0,ku,kx,ky,kl
            common /atest2/iu(100),ru(100),su(100)
cy
        call setrl(rl)
        a=ru(41)
        values(k0)=(a**2+1.0e0_rknd)*ux
        values(kx)=a**2+1.0e0_rknd
        num=0
        do i=1,5
            if(iu(i)/=1) cycle
            if(i==1) values(kl+num)=ux*a*2.0e0_rknd
            num=num+1
        enddo
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine a2xy(x,y,u,ux,uy,rl,itag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: values,rl
            character(len=80) :: su
            common /val0/k0,ku,kx,ky,kl
            common /atest2/iu(100),ru(100),su(100)
cy
        call setrl(rl)
        a=ru(41)
        values(k0)=(a**2+1.0e0_rknd)*uy
        values(ky)=a**2+1.0e0_rknd
        num=0
        do i=1,5
            if(iu(i)/=1) cycle
            if(i==1) values(kl+num)=uy*a*2.0e0_rknd
            num=num+1
        enddo
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine fxy(x,y,u,ux,uy,rl,itag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: values,rl
            character(len=80) :: su
            common /val0/k0,ku,kx,ky,kl
            common /atest2/iu(100),ru(100),su(100)
cy
        call setrl(rl)
        c0=ru(42)
        c1=ru(43)
        c2=ru(44)
        values(k0)=c2*u**2+c1*u-c0
        values(ku)=c2*u*2.0e0_rknd+c1
        num=0
        do i=1,5
            if(iu(i)/=1) cycle
            if(i==2) values(kl+num)=-1.0e0_rknd
            if(i==3) values(kl+num)=u
            if(i==4) values(kl+num)=u**2
            num=num+1
        enddo
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine gnxy(x,y,u,rl,itag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: values,rl
            character(len=80) :: su
            common /val1/k0,ku,kl
            common /atest2/iu(100),ru(100),su(100)
cy
c
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine gdxy(x,y,rl,itag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: values,rl
            character(len=80) :: su
            common /val2/k0,kl,klb,kub,kic,kim,kil
            common /atest2/iu(100),ru(100),su(100)
cy
        call setrl(rl)
        d=ru(45)
        values(k0)=d
        num=0
        do i=1,5
            if(iu(i)/=1) cycle
            if(i==5) values(kl+num)=1.0e0_rknd
            values(klb+num)=ru(20+i)
            values(kil+num)=ru(10+i)
            values(kub+num)=ru(30+i)
            num=num+1
        enddo
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine p1xy(x,y,u,ux,uy,rl,itag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: values,rl
            character(len=80) :: su
            common /val0/k0,ku,kx,ky,kl
            common /atest2/iu(100),ru(100),su(100)
cy
        uu=1.0e0_rknd
        e=exp(-20.0e0_rknd*(x**2+y**2))
        values(k0)=e*(u-uu)**2
        values(ku)=e*2.0e0_rknd*(u-uu)
        gamma=ru(1)
        num=0
        do i=1,5
            if(iu(i)/=1) cycle
            num=num+1
            values(k0)=values(k0)+gamma*(rl(num)-ru(10+i))**2
            values(kl+num-1)=2.0e0*gamma*(rl(num)-ru(10+i))
        enddo
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine p2xy(x,y,dx,dy,u,ux,uy,rl,itag,jtag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: values,rl
            character(len=80) :: su
            common /val0/k0,ku,kx,ky,kl
            common /atest2/iu(100),ru(100),su(100)
cy
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine qxy(x,y,u,ux,uy,rl,itag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: values,rl
            character(len=80) :: su
            common /val3/kf,kf1,kf2,kad
            common /atest2/iu(100),ru(100),su(100)
cy
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine sxy(rl,s,itag,values)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(2,*) :: values,rl
            character(len=80) :: su
            common /val4/j0,js,jl
            common /atest2/iu(100),ru(100),su(100)
cy
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine setrl(rl)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            real(kind=rknd), dimension(*) :: rl(*)
            character(len=80) :: su
            common /atest2/iu(100),ru(100),su(100)
cy
        num=0
        do i=1,5
            if(iu(i)/=1) cycle
            num=num+1
            ru(40+i)=rl(num)
        enddo
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine usrcmd(vx,vy,sf,itnode,ibndry,ip,rp,sp,iu,ru,su)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            integer(kind=iknd), dimension(5,*) :: itnode
            integer(kind=iknd), dimension(7,*) :: ibndry
            integer(kind=iknd), dimension(100) :: ip,iu
            real(kind=rknd), dimension(*) :: vx,vy
            real(kind=rknd), dimension(2,*) :: sf
            real(kind=rknd), dimension(100) :: rp,ru
            character(len=80), dimension(100) :: sp,su
cy
c
c       enter input mode
c
        num=0
        do i=1,5
            if(iu(i)==1) then
                num=num+1
                ru(40+i)=rp(90+num)
            endif
        enddo
        call usrset(iu,ru,su)
        nrl=0
        do i=1,5
            if(iu(i)/=1) iu(i)=0
            if(iu(i)==0) cycle
            nrl=nrl+1
            rp(90+nrl)=ru(40+i)
        enddo
        ip(13)=nrl
        ip(41)=0
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine usrfil(file,len)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            integer(kind=iknd), save :: len0
            character(len=80), save, dimension(100) :: file0
            character(len=80), dimension(*) :: file
cy
            data (file0(i),i=  1,10)/
     +  'n i= 1,n=gamma ,a= g,t=r',
     1  'n i= 1,n=irl1  ,a=i1,t=i',
     2  'n i= 2,n=irl2  ,a=i2,t=i',
     3  'n i= 3,n=irl3  ,a=i3,t=i',
     4  'n i= 4,n=irl4  ,a=i4,t=i',
     5  'n i= 5,n=irl5  ,a=i5,t=i',
     6  's n=irl1  ,v= 0,l="a -- static"',
     7  's n=irl1  ,v= 1,l="a -- optimize"',
     8  's n=irl2  ,v= 0,l="c0 -- static"',
     9  's n=irl2  ,v= 1,l="c0 -- optimize"'/
            data (file0(i),i= 11,16)/
     +  's n=irl3  ,v= 0,l="c1 -- static"',
     1  's n=irl3  ,v= 1,l="c1 -- optimize"',
     2  's n=irl4  ,v= 0,l="c2 -- static"',
     3  's n=irl4  ,v= 1,l="c2 -- optimize"',
     4  's n=irl5  ,v= 0,l="d -- static"',
     5  's n=irl5  ,v= 1,l="d -- optimize"'/
c
            data len0/16/
c
        len=len0
        do i=1,len
            file(i)=file0(i)
        enddo
        return
        end
c-----------------------------------------------------------------------
c
c            piecewise lagrange triangle multi grid package
c
c                  edition 13.0 - - - september, 2018
c
c-----------------------------------------------------------------------
        subroutine gdata(vx,vy,sf,itnode,ibndry,ip,rp,sp,iu,ru,su,sxy)
cx
            use mthdef
            implicit real(kind=rknd) (a-h,o-z)
            implicit integer(kind=iknd) (i-n)
            integer(kind=iknd), dimension(5,*) :: itnode
            integer(kind=iknd), dimension(7,*) :: ibndry
            integer(kind=iknd), dimension(100) :: ip,iu
            integer(kind=iknd), save, dimension(13) :: ix,iy
            integer(kind=iknd), save :: ntf,nvf,nbf,iprob,ispd
            integer(kind=iknd), save :: iadapt,ifirst
            real(kind=rknd), dimension(*) :: vx,vy
            real(kind=rknd), dimension(2,*) :: sf
            real(kind=rknd), dimension(100) :: rp,ru
            real(kind=rknd), save :: hmax,grade
            real(kind=rknd), save, dimension(5) :: rllb,rlub,rlic
            character(len=80), dimension(100) :: sp,su
cy
            external sxy
            data ix/1,3,3,1,1,-1,-1,-3,-3,-1,-1,1,0/
            data iy/-1,-1,1,1,3,3,1,1,-1,-1,-3,-3,0/
            data nvf,ntf,nbf/13,4,16/
            data iprob,ispd,iadapt,ifirst/4,1,5,1/
            data hmax,grade/0.1e0_rknd,1.5e0_rknd/
            data rlub/4.0e0_rknd,5.0e0_rknd,5.0e0_rknd,
     +                 5.0e0_rknd,0.5e0_rknd/
            data rlic/1.0e0_rknd,1.0e0_rknd,1.0e0_rknd,
     +                 1.0e0_rknd,-0.5e0_rknd/
            data rllb/0.0e0_rknd,-5.0e0_rknd,0.0e0_rknd,
     +                 0.0e0_rknd,-1.0e0_rknd/
c
        if(ip(41)==1) then
            sp(2)='ident'
            sp(1)='ident'
            sp(3)='ident'
            sp(4)='ident'
            sp(5)='ident_figxxx.ext'
            sp(6)='ident_mpixxx.rw'
            sp(7)='ident.jnl'
            sp(9)='ident_mpixxx.out'
            ip(7)=0
            iu(1)=1
            iu(2)=1
            iu(3)=1
            iu(4)=1
            iu(5)=1
            do i=1,5
                ru(10+i)=rlic(i)
                ru(20+i)=rllb(i)
                ru(30+i)=rlub(i)
                ru(40+i)=rlic(i)
            enddo
            ru(1)=1.0e0_rknd
        endif
c
        num=0
        do i=1,5
            if(iu(i)==1) then
                num=num+1
                rp(90+num)=rlic(i)
            endif
        enddo
        ip(13)=num
        ip(6)=4
        if(num==0) ip(6)=1
c
c
        do i=1,nvf
            vx(i)=real(ix(i),rknd)
            vy(i)=real(iy(i),rknd)
        enddo
        do i=1,nbf
            ibndry(1,i)=i
            ibndry(2,i)=i+1
            if(i>=nvf) then
                ibndry(1,i)=(i-nvf)*3+1
                ibndry(2,i)=nvf
            endif
            ibndry(3,i)=0
            ibndry(4,i)=1
            if(i>=nvf) ibndry(4,i)=0
            ibndry(5,i)=0
            ibndry(6,i)=0
            ibndry(7,i)=1
            ii=i-(i/3)*3
            if(ii==2.and.i<=nvf) then
                ibndry(4,i)=2
                ibndry(7,i)=i
            endif
            sf(1,i)=0.0e0_rknd
            sf(2,i)=0.0e0_rknd
        enddo
        ibndry(2,nvf-1)=1
c
        ip(1)=ntf
        ip(2)=nvf
        ip(3)=nbf
        ip(5)=max(ip(5),ifirst)
        ip(6)=iprob
        ip(8)=ispd
        ip(20)=iadapt
        rp(12)=hmax
        rp(13)=grade
c
c       make itnode, find symmetries
c
        call sklutl(0_iknd,vx,vy,sf,itnode,ibndry,ip,rp,iflag,sxy)
        call sklutl(2_iknd,vx,vy,sf,itnode,ibndry,ip,rp,iflag,sxy)
        return
        end

		
.


AD:

NEW PAGES:

[ODDNUGGET]

[GOPHER]