program f90_DRAWseep
    !Saturation line
    implicit none
    integer::i,j,k,l,n,ne,kk,ii,jj
    integer::n1,n2,n3,k1,k2,k3
    character::strcom*256           !書出用コメント
    integer::NODT                   !節点総数
    integer::NELT                   !要素総数
    integer::MATEL                  !材料種類数
    integer::KOH                    !全水頭指定節点数
    integer::KOQ                    !流量指定節点数
    integer::KOU                    !浸潤境界指定節点数
    integer::nt                     !全自由度（総節点数×１[１節点自由度]）
    integer::nod                    !1要素節点数
    integer::nhen=1                 !1節点自由度
    integer,allocatable::kakom(:,:) !要素構成節点番号
    integer,allocatable::matno(:)   !材料種別No
    real(4),allocatable::x(:)       !節点x座標
    real(4),allocatable::z(:)       !節点y座標
    real(4),allocatable::hvec(:)    !全体全水頭ベクトル
    real(4),allocatable::qvec(:)    !全体節点流量ベクトル
    real(4),allocatable::pvec(:)    !圧力指定点流量
    integer,allocatable::nokh(:)
    integer,allocatable::nokq(:)
    integer,allocatable::noku(:)
    real(4),allocatable::vx(:)      !x方向流速ベクトル
    real(4),allocatable::vz(:)      !y方向流速ベクトル
    real(4),allocatable::Akr(:)     !透水係数比
    real(4)::QTi,QTo
    real(4)::rw
    real(4)::x1,y1,z1,x2,y2,z2,x3,y3,z3
    real(4)::xg,zg,xx,zz,yy
    real(4),allocatable::hpv(:)
    real(4),allocatable::satx(:,:)
    real(4),allocatable::satz(:,:)
    integer,allocatable::nd(:)
    real(4),allocatable::yp(:)
    integer::id,iw,ik
    integer::kkmax,kkm1,kkm2,nsat,kdraw

    character :: linebuf*1000

    open(11,file='tmp_sat.txt',status='old')
    read(11,*) kkm1,kkm2
    kkmax=kkm1+kkm2
    if(0<kkmax)allocate(yp(1:kkmax))
    if(0<kkm1) read(11,*) (yp(j),j=1,kkm1)
    if(0<kkm2) read(11,*) (yp(j),j=kkm1+1,kkmax)
    if(0<kkmax)read(11,*) kdraw
    close(11)

    if(kkmax<=0)stop

    !***************************
    !data input
    !***************************
    open(11,file='fnameW.csv',status='old')
    read(11,'(a)') strcom
    read(11,'()')
    read(11,*) nod,NODT,NELT,MATEL,KOH,KOQ,KOU
    !------------------------------------------------------------------------------------------
    !配列寸法宣言
    !------------------------------------------------------------------------------------------
    nt=NODT*nhen
    if(nod==3)nsat=NELT
    if(nod==4)nsat=NELT*4
    allocate(kakom(1:NELT,1:nod))
    allocate(matno(1:NELT))
    allocate(x(1:NODT))
    allocate(z(1:NODT))
    allocate(hvec(1:nt))
    allocate(qvec(1:nt))
    allocate(pvec(1:nt))
    allocate(hpv(1:nt))
    allocate(vx(1:NELT))
    allocate(vz(1:NELT))
    allocate(Akr(1:NELT))
    allocate(nd(1:kkmax))
    allocate(satx(1:kkmax,1:nsat))
    allocate(satz(1:kkmax,1:nsat))
    if(0<KOH)allocate(nokh(1:KOH))
    if(0<KOQ)allocate(nokq(1:KOQ))
    if(0<KOU)allocate(noku(1:KOU))

    read(11,'()')
    read(11,'()')
    !node,x,z,KOH,KOQ,KOU,Hinp,Qinp
    n1=0
    n2=0
    n3=0
    do i=1,NODT
        read(11,*) j,rw,rw,k1,k2,k3,rw,rw
        if(0<KOH)then
            if(k1==1)then
                n1=n1+1
                nokh(n1)=i
            end if
        end if
        if(0<KOQ)then
            if(k2==1)then
                n2=n2+1
                nokq(n2)=i
            end if
        end if
        if(0<KOU)then
            if(k3==1)then
                n3=n3+1
                noku(n3)=i
            end if
        end if
    end do
    read(11,'()')
    read(11,'()')
    !element,node-1,node-2,node-3,Ak0,alpha,em,matno
    do ne=1,NELT
        read(11,*) i,(kakom(ne,j),j=1,nod),rw,rw,rw,matno(ne)
    end do
    read(11,'()')
    read(11,'()')
    !node,coord-x,coord-z,hvec,qvec,pvec
    do i=1,NODT
        read(11,*) j,x(i),z(i),hvec(i),qvec(i),pvec(i)
    end do
    read(11,'()')
    read(11,'()')
    !element,vx,vz,vm,Ak0,Akr,matno
    do ne=1,NELT
        read(11,*) j,vx(ne),vz(ne),rw,rw,Akr(ne),iw
    end do
    close(11)

    !等高線上の点の検索
    if(nod==3)jj=1
    if(nod==4)jj=4
    do kk=1,kkmax
        yy=yp(kk)
        if(kk<=kkm1)then
            do i=1,nt; hpv(i)=pvec(i); end do
        else
            do i=1,nt; hpv(i)=hvec(i); end do
        end if
        do ne=1,NELT
            do ii=1,jj
                select case(ii)
                    case(1)
                        i=kakom(ne,1); j=kakom(ne,2); k=kakom(ne,3)
                    case (2)
                        i=kakom(ne,1); j=kakom(ne,3); k=kakom(ne,4)
                    case (3)
                        i=kakom(ne,1); j=kakom(ne,2); k=kakom(ne,4)
                    case (4)
                        i=kakom(ne,2); j=kakom(ne,3); k=kakom(ne,4)
                end select
                id=0
                if(yy> hpv(i).and.yy< hpv(j).and.yy< hpv(k))id=1
                if(yy< hpv(i).and.yy> hpv(j).and.yy< hpv(k))id=1
                if(yy< hpv(i).and.yy< hpv(j).and.yy> hpv(k))id=1
                if(yy> hpv(i).and.yy> hpv(j).and.yy< hpv(k))id=1
                if(yy< hpv(i).and.yy> hpv(j).and.yy> hpv(k))id=1
                if(yy> hpv(i).and.yy< hpv(j).and.yy> hpv(k))id=1
                if(id==1)then
                    n=n+1
                    x1=x(i); y1=hpv(i); z1=z(i)
                    x2=x(j); y2=hpv(j); z2=z(j)
                    x3=x(k); y3=hpv(k); z3=z(k)
                    xg=(x1+x2+x3)/3.0
                    zg=(z1+z2+z3)/3.0
                    call SATPOINT(yy,x1,y1,z1,x2,y2,z2,x3,y3,z3,xg,zg,xx,zz)
                    satx(kk,n)=xx
                    satz(kk,n)=zz
                end if
            end do
        end do
        nd(kk)=n
        !x座標の小さい順の並び替え
        do i=1,nd(kk)-1
            do j=i+1,nd(kk)
                if(satx(kk,i)>satx(kk,j))then
                    rw=satx(kk,i)
                    satx(kk,i)=satx(kk,j)
                    satx(kk,j)=rw

                    rw=satz(kk,i)
                    satz(kk,i)=satz(kk,j)
                    satz(kk,j)=rw
                end if
            end do
        end do
    end do

    call DRAW_MESH(kakom,matno,x,z,nokh,nokq,noku,nod,NODT,NELT,KOH,KOQ,KOU)
    call DRAW_SAT(kakom,matno,x,z,nokh,satx,satz,nd,nod,NODT,NELT,KOH,kkmax,nsat)
    call DRAW_VEC(kakom,Akr,x,z,vx,vz,satx,satz,nd,kdraw,nod,NODT,NELT,kkmax,nsat)

stop


contains



   subroutine DRAW_MESH(kakom,matno,x,z,nokh,nokq,noku,nod,NODT,NELT,KOH,KOQ,KOU)
        integer::nod,NODT,NELT,KOH,KOQ,KOU
        integer::kakom(1:NELT,1:nod),matno(1:NELT)
        integer::nokh(1:KOH),nokq(1:KOQ),noku(1:KOU)
        real(4)::x(1:NODT),z(1:NODT)

        integer::i,ne,ii
        real(4)::xmin,xmax,zmin,zmax

        xmin=(x(1))
        xmax=(x(1))
        zmin=(z(1))
        zmax=(z(1))
        do i=1,NODT
            if((x(i))<xmin)xmin=(x(i))
            if(xmax<(x(i)))xmax=(x(i))
            if((z(i))<zmin)zmin=(z(i))
            if(zmax<(z(i)))zmax=(z(i))
        end do

        open(12, file='gpl_mesh.txt', status='replace')
        write(12,*) 'reset'
        write(12,*) 'set terminal postscript eps enhanced color font "Arial" 12'
        write(12,*) 'set output "fig_mesh.eps"'
        write(12,*) '#'
        write(12,*) 'set size ratio -1'
        write(12,*) '#'
        write(12,*) 'set xrange [',xmin,':',xmax,']'
        write(12,*) 'set yrange [',zmin,':',zmax,']'
        write(12,*) 'set border 0'
        write(12,*) 'set xtics 0,0,0'
        write(12,*) 'set ytics 0,0,0'
        write(12,*) 'set xtics nomirror'
        write(12,*) 'set ytics nomirror'
        write(12,*) '#'
        write(12,*) 'set rmargin 11'
        write(12,*) '#'
        write(12,*) 'set style line  1 lt 1 lc rgb "#ffffcc" lw 1'
        write(12,*) 'set style line  2 lt 1 lc rgb "#ccffcc" lw 1'
        write(12,*) 'set style line  3 lt 1 lc rgb "#cccccc" lw 1'
        write(12,*) 'set style line  4 lt 1 lc rgb "#ccffcc" lw 1'
        write(12,*) 'set style line  5 lt 1 lc rgb "#ffffcc" lw 1'
        write(12,*) 'set style line  6 lt 1 lc rgb "#808080" lw 0.5' !gray
        write(12,*) '#'
        write(12,*) 'plot \'
        do ne=1,NELT
            write(12,*) '"-" with filledcurves linestyle ',matno(ne),' notitle,\'
        end do
        do ne=1,NELT
            write(12,*) '"-" with lines linestyle 6 notitle,\'
        end do
        if(0<KOH)then
            write(12,*) '"-" with points pt 4 ps 1.2 lt 7 lw 2 notitle,\'
        end if
        if(0<KOQ)then
            write(12,*) '"-" with points pt 6 ps 1.2 lt 7 lw 2 notitle,\'
        end if
        if(0<KOU)then
            write(12,*) '"-" with points pt 8 ps 1.2 lt 7 lw 2 notitle,\'
        end if
        write(12,*) '"-" with dots notitle'

        !要素塗りつぶし,!要素線描画(gray)
        select case(nod)
            case(3)
                do ii=1,2
                    do ne=1,NELT
                        i=kakom(ne,1)
                        j=kakom(ne,2)
                        k=kakom(ne,3)
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) (x(j)),' ',(z(j))
                        write(12,*) (x(k)),' ',(z(k))
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) 'e'
                    end do
                end do
            case(4)
                do ii=1,2
                    do ne=1,NELT
                        i=kakom(ne,1)
                        j=kakom(ne,2)
                        k=kakom(ne,3)
                        l=kakom(ne,4)
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) (x(j)),' ',(z(j))
                        write(12,*) (x(k)),' ',(z(k))
                        write(12,*) (x(l)),' ',(z(l))
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) 'e'
                    end do
                end do
        end select

        if(0<KOH)then
            do i=1,KOH
                write(12,*) x(nokh(i)),' ',z(nokh(i))
            end do
            write(12,*) 'e'
        end if

        if(0<KOQ)then
            do i=1,KOQ
                write(12,*) x(nokq(i)),' ',z(nokq(i))
            end do
            write(12,*) 'e'
        end if

        if(0<KOU)then
            do i=1,KOU
                write(12,*) x(noku(i)),' ',z(noku(i))
            end do
            write(12,*) 'e'
        end if

        write(12,*) xmin,' ',zmin
        write(12,*) 'e'
        write(12,*) 'quit'
        close(12)

        call system('gnuplot gpl_mesh.txt')

    end subroutine DRAW_MESH



    subroutine DRAW_SAT(kakom,matno,x,z,nokh,satx,satz,nd,nod,NODT,NELT,KOH,kkmax,nsat)
        integer::nod,NODT,NELT,KOH,kkmax,nsat
        integer::kakom(1:NELT,1:nod),matno(1:NELT),nokh(1:KOH),nd(1:kkmax)
        real(4)::x(1:NODT),z(1:NODT)
        real(4)::satx(1:kkmax,1:nsat),satz(1:kkmax,1:nsat)

        integer::i,ne,kk,ii
        real(4)::xmin,xmax,zmin,zmax

        !作図範囲設定
        xmin=(x(1))
        xmax=(x(1))
        zmin=(z(1))
        zmax=(z(1))
        do i=1,NODT
            if((x(i))<xmin)xmin=(x(i))
            if(xmax<(x(i)))xmax=(x(i))
            if((z(i))<zmin)zmin=(z(i))
            if(zmax<(z(i)))zmax=(z(i))
        end do

        open(12, file='gpl_sat.txt', status='replace')
        write(12,*) 'reset'
        write(12,*) 'set terminal postscript eps enhanced color font "Arial" 12'
        write(12,*) 'set output "fig_sat.eps"'
        write(12,*) '#'
        write(12,*) 'set size ratio -1'
        write(12,*) '#'
        write(12,*) 'set xrange [',xmin,':',xmax,']'
        write(12,*) 'set yrange [',zmin,':',zmax,']'
        write(12,*) 'set border 0'
        write(12,*) 'set xtics 0,0,0'
        write(12,*) 'set ytics 0,0,0'
        write(12,*) 'set xtics nomirror'
        write(12,*) 'set ytics nomirror'
        write(12,*) '#'
        write(12,*) 'set rmargin 11'
        write(12,*) '#'
        write(12,*) 'set style line  1 lt 1 lc rgb "#ffffcc" lw 1'
        write(12,*) 'set style line  2 lt 1 lc rgb "#ccffcc" lw 1'
        write(12,*) 'set style line  3 lt 1 lc rgb "#cccccc" lw 1'
        write(12,*) 'set style line  4 lt 1 lc rgb "#ccffcc" lw 1'
        write(12,*) 'set style line  5 lt 1 lc rgb "#ffffcc" lw 1'
        write(12,*) 'set style line  6 lt 1 lc rgb "#808080" lw 0.5' !gray
        write(12,*) '#'
        write(12,*) 'plot \'
        do ne=1,NELT
            write(12,*) '"-" with filledcurves ls ',matno(ne),' notitle,\'
        end do
        do ne=1,NELT
            write(12,*) '"-" with lines ls 6 notitle,\'
        end do
        write(12,*) '"-" with points pointtype 4 pointsize 0.5 lt 7 notitle,\'
        do kk=1,kkmax
            if(kk<=kkm1)then
                write(12,*) '"-" with points pointtype 6 pointsize 0.5 lt 10 notitle,\' !red circle
            else
                write(12,*) '"-" with points pointtype 6 pointsize 0.5 lt 12 notitle,\' !blue circle
            end if
        end do
        write(12,*) '"-" with dots notitle'

        !要素塗りつぶし,!要素線描画(gray)
        select case(nod)
            case(3)
                do ii=1,2
                    do ne=1,NELT
                        i=kakom(ne,1)
                        j=kakom(ne,2)
                        k=kakom(ne,3)
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) (x(j)),' ',(z(j))
                        write(12,*) (x(k)),' ',(z(k))
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) 'e'
                    end do
                end do
            case(4)
                do ii=1,2
                    do ne=1,NELT
                        i=kakom(ne,1)
                        j=kakom(ne,2)
                        k=kakom(ne,3)
                        l=kakom(ne,4)
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) (x(j)),' ',(z(j))
                        write(12,*) (x(k)),' ',(z(k))
                        write(12,*) (x(l)),' ',(z(l))
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) 'e'
                    end do
                end do
        end select

        !全水頭指定境界表示
        do i=1,KOH
            write(12,*) x(nokh(i)),' ',z(nokh(i))
        end do
        write(12,*) 'e'
        !等圧線上の点表示
        do kk=1,kkmax
            do i=1,nd(kk)
                write(12,*) (satx(kk,i)),' ',(satz(kk,i))
            end do
            write(12,*) 'e'
        end do

        write(12,*) xmin,' ',zmin
        write(12,*) 'e'
        write(12,*) 'quit'
        close(12)

        !gnuplot 実行
        call system('gnuplot gpl_sat.txt')

    end subroutine DRAW_SAT



    subroutine SATPOINT(yy,x1,y1,z1,x2,y2,z2,x3,y3,z3,xg,zg,xx,zz)
        real(4)::x1,y1,z1,x2,y2,z2,x3,y3,z3
        real(4)::xg,zg,xx,zz,yy

        real(4)::aa,bb,cc,dd,a,b

        !aa*x+bb*y+cc*z+dd=0
        aa=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1)
        bb=(z2-z1)*(x3-x1)-(z3-z1)*(x2-x1)
        cc=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1)
        dd=-x1*((y2-y1)*(z3-z1)-(y3-y1)*(z2-z1)) &
           -y1*((z2-z1)*(x3-x1)-(z3-z1)*(x2-x1)) &
           -z1*((x2-x1)*(y3-y1)-(x3-x1)*(y2-y1))
        !z=-aa/cc*xx-bb/cc*y-dd/cc
        a=-aa/cc
        b=-bb/cc*yy-dd/cc
        xx=(xg+zg*a-a*b)/(1.0+a*a)
        zz=a*xx+b

    end subroutine SATPOINT



    subroutine DRAW_VEC(kakom,Akr,x,z,vx,vz,satx,satz,nd,kdraw,nod,NODT,NELT,kkmax,nsat)
        integer::kdraw,nod,NODT,NELT,kkmax,nsat
        integer::kakom(1:NELT,1:nod),nd(1:kkmax)
        real(4)::Akr(1:NELT)
        real(4)::x(1:NODT),z(1:NODT)
        real(4)::vx(1:NELT),vz(1:NELT)
        real(4)::satx(1:kkmax,1:nsat),satz(1:kkmax,1:nsat)

        integer::i,j,k,l,ii,ne,kk
        real(4)::xmin,xmax,zmin,zmax,vscale,vmax
        real(4)::xx,zz
        real(4)::fact=1.0e-6

        vmax=0.0
        do ne=1,NELT
            if(vmax<sqrt(vx(ne)**2+vz(ne)**2))vmax=sqrt(vx(ne)**2+vz(ne)**2)
        end do

        !作図範囲設定
        xmin=(x(1))
        xmax=(x(1))
        zmin=(z(1))
        zmax=(z(1))
        do i=1,NODT
            if((x(i))<xmin)xmin=(x(i))
            if(xmax<(x(i)))xmax=(x(i))
            if((z(i))<zmin)zmin=(z(i))
            if(zmax<(z(i)))zmax=(z(i))
        end do
        if(xmax-xmin<zmax-zmin)then
            vscale=(zmax-zmin)/20.0/vmax
        else
            vscale=(xmax-xmin)/20.0/vmax
        end if
            print "('vmax=',e15.7)",vmax

        open(12, file='gpl_vec.txt', status='replace')
        write(12,*) 'reset'
        write(12,*) 'set terminal postscript eps enhanced color font "Arial" 12'
        write(12,*) 'set output "fig_vec.eps"'
        write(12,*) '#'
        write(12,*) 'set size ratio -1'
        write(12,*) '#'
        write(12,*) 'set xrange [',xmin-5,':',xmax+5,']'
        write(12,*) 'set yrange [',zmin-5,':',zmax+5,']'
        write(12,*) 'set border 0'
        write(12,*) 'set xtics 0,0,0'
        write(12,*) 'set ytics 0,0,0'
        write(12,*) 'set xtics nomirror'
        write(12,*) 'set ytics nomirror'
        write(12,*) '#'
        write(12,*) 'set rmargin 11'
        write(12,*) '#'
!set style line n lt m lc color lw k
!とすることで、 n番目の線種を、ラインタイプ(lt)をn,色(lc)をcolor,太さ(lw)をk に設定できます。
        write(12,*) 'set style line  1 lt 1 lc rgb "#ccffff" lw 1'
        write(12,*) 'set style line  2 lt 1 lc rgb "#ffffcc" lw 1'
        write(12,*) 'set style line  3 lt 1 lc rgb "#808080" lw 0.5' !gray
        write(12,*) 'set style line  4 lt 1 lc rgb "#ff0000" lw 3'   !red
        write(12,*) 'set style line  5 lt 1 lc rgb "#0000ff" lw 1'   !blue
        write(12,*) '#'
        write(12,*) 'plot \'
        do ne=1,NELT
            if(1.0-fact<Akr(ne))then
                write(12,*) '"-" with filledcurves linestyle 1 notitle,\'
            else
                write(12,*) '"-" with filledcurves linestyle 2 notitle,\'
            end if
        end do
        do ne=1,NELT
            write(12,*) '"-" with lines linestyle 3 notitle,\'
        end do
        if(0<kdraw)write(12,*) '"-" with lines linestyle 4 notitle,\'
        write(12,*) '"-" every 3::1 with vector linestyle 5 notitle,\'
        write(12,*) '"-" with dots notitle'

        select case(nod)
            case(3)
                !要素塗りつぶし,!要素線描画(gray)
                do ii=1,2
                    do ne=1,NELT
                        i=kakom(ne,1)
                        j=kakom(ne,2)
                        k=kakom(ne,3)
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) (x(j)),' ',(z(j))
                        write(12,*) (x(k)),' ',(z(k))
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) 'e'
                    end do
                end do
                !不飽和境界
                if(0<kdraw)then
                    kk=kdraw
                    do i=1,nd(kk)
                        write(12,*) (satx(kk,i)),' ',(satz(kk,i))
                    end do
                    write(12,*) 'e'
                end if
                !流速ベクトル(blue)
                do ne=1,NELT
                    i=kakom(ne,1)
                    j=kakom(ne,2)
                    k=kakom(ne,3)
                    xx=(x(i)+x(j)+x(k))/3.0
                    zz=(z(i)+z(j)+z(k))/3.0
                    write(12,*) xx,' ',zz,' ',vscale*vx(ne),' ',vscale*vz(ne)
                end do
                write(12,*) 'e'
            case(4)
                !要素塗りつぶし,!要素線描画(gray)
                do ii=1,2
                    do ne=1,NELT
                        i=kakom(ne,1)
                        j=kakom(ne,2)
                        k=kakom(ne,3)
                        l=kakom(ne,4)
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) (x(j)),' ',(z(j))
                        write(12,*) (x(k)),' ',(z(k))
                        write(12,*) (x(l)),' ',(z(l))
                        write(12,*) (x(i)),' ',(z(i))
                        write(12,*) 'e'
                    end do
                end do
                !不飽和境界
                if(0<kdraw)then
                    kk=kdraw
                    do i=1,nd(kk)
                        write(12,*) (satx(kk,i)),' ',(satz(kk,i))
                    end do
                    write(12,*) 'e'
                end if
                !流速ベクトル(blue)
                do ne=1,NELT
                    i=kakom(ne,1)
                    j=kakom(ne,2)
                    k=kakom(ne,3)
                    l=kakom(ne,4)
                    xx=0.25*(x(i)+x(j)+x(k)+x(l))
                    zz=0.25*(z(i)+z(j)+z(k)+z(l))
                    write(12,*) xx,' ',zz,' ',vscale*vx(ne),' ',vscale*vz(ne)
               end do
               write(12,*) 'e'
        end select

        write(12,*) xmin,' ',zmin
        write(12,*) 'e'
        write(12,*) 'quit'
        close(12)

        !gnuplot 実行
        call system('gnuplot gpl_vec.txt')

    end subroutine DRAW_VEC



    subroutine del_spaces(s)
        character (*), intent (inout) :: s
        character (len=len(s)) tmp
        integer i, j
        j = 1
        do i = 1, len(s)
            if (s(i:i)==' ') cycle
            tmp(j:j) = s(i:i)
            j = j + 1
        end do
        s = tmp(1:j-1)
    end subroutine del_spaces


end program f90_DRAWseep