module defpi
implicit none
real(8),parameter::pi=3.14159265358979323846D0
end module defpi

program f90_PSP
    use defpi
    real(8)::ELT,ELC,ELG,ELF,ELB,ELS,LG1,LG2
    real(8)::TC_1,DG_1,HG_1,D1_1,OS_1,PS_1,GH_1,GW_1
    real(8)::TC_2,DG_2,HG_2,D1_2,OS_2,PS_2,GH_2,GW_2
    real(8)::TC,DG,HG,D1,OS,PS
    real(8)::ww,wu,wd
    character(len=50)::dummy,fnameR,fnameW
    character(len=15)::elstr
    integer::i
    real(8)::dh,dw,xx,yy,work

    call getarg(1,fnameR)

    open(11,file=fnameR,status='old')
    read(11,*) dummy,ELT
    read(11,*) dummy,ELC
    read(11,*) dummy,ELG
    read(11,*) dummy,ELF
    read(11,*) dummy,ELB
    read(11,*) dummy,ELS
    read(11,*) dummy,LG1
    read(11,*) dummy,LG2
    read(11,*) dummy,TC_1
    read(11,*) dummy,DG_1
    read(11,*) dummy,HG_1
    read(11,*) dummy,D1_1
    read(11,*) dummy,OS_1
    read(11,*) dummy,PS_1
    read(11,*) dummy,GH_1
    read(11,*) dummy,GW_1
    read(11,*) dummy,TC_2
    read(11,*) dummy,DG_2
    read(11,*) dummy,HG_2
    read(11,*) dummy,D1_2
    read(11,*) dummy,OS_2
    read(11,*) dummy,PS_2
    read(11,*) dummy,GH_2
    read(11,*) dummy,GW_2
    close(11)

    ww=LG1
    wu=10.0D0
    wd=10.0D0
    ELgc=ELG+8.0D0

    fnameW='_P_ps_1.txt'
    open(12, file=fnameW, status='replace')
    ! polygon for structure (solid line + pattern filling)
    ! outline
    write(12,'(2(e15.7))') 0.0D0              ,-ww-wu
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2,-ww-wu
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2,-ww+1.0D0
    write(12,'(2(e15.7))') 1.0D0              ,-ww+1.0D0
    write(12,'(2(e15.7))') 1.0D0              , ww-1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2, ww-1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2, ww+wu+2.0D0
    write(12,'(2(e15.7))') 0.0D0              , ww+wu+2.0D0
    write(12,'(2(e15.7))') 0.0D0              ,-ww-wu
    close(12)

    fnameW='_P_ps_2.txt'
    open(12, file=fnameW, status='replace')
    ! plygon for structure (solid line + white filling)
    ! rooms
    dw=1.0D0
    !upstream
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 1.0D0       ,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 1.0D0*LG1-dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 1.0D0*LG1-dw,-ww
    write(12,'(2(e15.7))') 1.0D0       ,-ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 1.0D0*LG1+dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 2.0D0*LG1-dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 2.0D0*LG1-dw,-ww
    write(12,'(2(e15.7))') 1.0D0*LG1+dw,-ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 2.0D0*LG1+dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 3.0D0*LG1-dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 3.0D0*LG1-dw,-ww
    write(12,'(2(e15.7))') 2.0D0*LG1+dw,-ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 3.0D0*LG1+dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1-dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1-dw,-ww
    write(12,'(2(e15.7))') 3.0D0*LG1+dw,-ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 4.0D0*LG1+dw          ,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2-dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2-dw,-ww
    write(12,'(2(e15.7))') 4.0D0*LG1+dw          ,-ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2+dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2-dw,-ww-wu+1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2-dw,-ww
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2+dw,-ww
    !downstream
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 1.0D0       ,ww+wu-1.0D0
    write(12,'(2(e15.7))') 1.0D0*LG1-dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 1.0D0*LG1-dw,ww
    write(12,'(2(e15.7))') 1.0D0       ,ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 1.0D0*LG1+dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 2.0D0*LG1-dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 2.0D0*LG1-dw,ww
    write(12,'(2(e15.7))') 1.0D0*LG1+dw,ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 2.0D0*LG1+dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 3.0D0*LG1-dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 3.0D0*LG1-dw,ww
    write(12,'(2(e15.7))') 2.0D0*LG1+dw,ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 3.0D0*LG1+dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1-dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1-dw,ww
    write(12,'(2(e15.7))') 3.0D0*LG1+dw,ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 4.0D0*LG1+dw          ,ww+wu-1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2-dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2-dw,ww
    write(12,'(2(e15.7))') 4.0D0*LG1+dw          ,ww
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2+dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2-dw,ww+wu-1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2-dw,ww
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2+dw,ww
    !draft gate
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 1.0D0*LG1-0.5D0*GW_1,ww+wd
    write(12,'(2(e15.7))') 1.0D0*LG1-1.0D0     ,ww+wd
    write(12,'(2(e15.7))') 1.0D0*LG1-1.0D0     ,ww+wd+1.0D0
    write(12,'(2(e15.7))') 1.0D0*LG1-0.5D0*GW_1,ww+wd+1.0D0
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 1.0D0*LG1+0.5D0*GW_1,ww+wd
    write(12,'(2(e15.7))') 1.0D0*LG1+1.0D0     ,ww+wd
    write(12,'(2(e15.7))') 1.0D0*LG1+1.0D0     ,ww+wd+1.0D0
    write(12,'(2(e15.7))') 1.0D0*LG1+0.5D0*GW_1,ww+wd+1.0D0
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 3.0D0*LG1-0.5D0*GW_1,ww+wd
    write(12,'(2(e15.7))') 3.0D0*LG1-1.0D0     ,ww+wd
    write(12,'(2(e15.7))') 3.0D0*LG1-1.0D0     ,ww+wd+1.0D0
    write(12,'(2(e15.7))') 3.0D0*LG1-0.5D0*GW_1,ww+wd+1.0D0
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 3.0D0*LG1+0.5D0*GW_1,ww+wd
    write(12,'(2(e15.7))') 3.0D0*LG1+1.0D0     ,ww+wd
    write(12,'(2(e15.7))') 3.0D0*LG1+1.0D0     ,ww+wd+1.0D0
    write(12,'(2(e15.7))') 3.0D0*LG1+0.5D0*GW_1,ww+wd+1.0D0
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2-0.5D0*GW_2,ww+wd
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2+0.5D0*GW_2,ww+wd
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2+0.5D0*GW_2,ww+wd+1.0D0
    write(12,'(2(e15.7))') 4.0D0*LG1+1.0D0*LG2-0.5D0*GW_2,ww+wd+1.0D0
    close(12)

    ! Assembly bay (broken line)
    fnameW='_P_ps_3.txt'
    open(12, file=fnameW, status='replace')
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2,-ww
    write(12,'(2(e15.7))') 7.0D0*LG1+2.0D0*LG2,-ww
    write(12,'(2(e15.7))') 7.0D0*LG1+2.0D0*LG2, ww
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2, ww
    close(12)

    fnameW='_P_ps_4.txt'
    open(12, file=fnameW, status='replace')
    ! joint (solid line)
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 2.0D0*LG1,-ww-wu
    write(12,'(2(e15.7))') 2.0D0*LG1, ww+wd+2.0D0
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 4.0D0*LG1,-ww-wu
    write(12,'(2(e15.7))') 4.0D0*LG1, ww+wd+2.0D0
    write(12,'(a)') '>'
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2,-ww-wu
    write(12,'(2(e15.7))') 4.0D0*LG1+2.0D0*LG2, ww+wd+2.0D0
    close(12)

    fnameW='_P_arrow.txt'
    open(12, file=fnameW, status='replace')
    ! arrow
    yy=ww+wd+4.0D0
    write(12,'(4(e15.7))') 0.0D0*LG1,yy,1.0D0*LG1,yy
    write(12,'(4(e15.7))') 1.0D0*LG1,yy,2.0D0*LG1,yy
    write(12,'(4(e15.7))') 2.0D0*LG1,yy,3.0D0*LG1,yy
    write(12,'(4(e15.7))') 3.0D0*LG1,yy,4.0D0*LG1,yy
    write(12,'(4(e15.7))') 4.0D0*LG1+0.0D0*LG2,yy,4.0D0*LG1+1.0D0*LG2,yy
    write(12,'(4(e15.7))') 4.0D0*LG1+1.0D0*LG2,yy,4.0D0*LG1+2.0D0*LG2,yy
    yy=ww+wd+8.0D0
    write(12,'(4(e15.7))') 0.0D0*LG1,yy,2.0D0*LG1,yy
    write(12,'(4(e15.7))') 2.0D0*LG1,yy,4.0D0*LG1,yy
    write(12,'(4(e15.7))') 4.0D0*LG1,yy,4.0D0*LG1+2.0D0*LG2,yy
    xx=-2.0D0
    write(12,'(4(e15.7))') xx,-ww-wu,xx,-ww
    write(12,'(4(e15.7))') xx,-ww   ,xx,0.0D0
    write(12,'(4(e15.7))') xx,0.0D0 ,xx,ww
    write(12,'(4(e15.7))') xx,ww    ,xx,ww+wd
    close(12)

    fnameW='_P_line.txt'
    open(12, file=fnameW, status='replace')
    ! line
    yy=ww+wd+2.0D0
    write(12,'(4(e15.7))') 0.0D0*LG1,yy,0.0D0*LG1,yy+7.0D0
    write(12,'(4(e15.7))') 2.0D0*LG1,yy,2.0D0*LG1,yy+7.0D0
    write(12,'(4(e15.7))') 4.0D0*LG1,yy,4.0D0*LG1,yy+7.0D0
    write(12,'(4(e15.7))') 4.0D0*LG1+2.0D0*LG2,yy,4.0D0*LG1+2.0D0*LG2,yy+7.0D0
    yy=ww+wd+2.0D0
    write(12,'(4(e15.7))') 1.0D0*LG1,yy,1.0D0*LG1,yy+3.0D0
    write(12,'(4(e15.7))') 3.0D0*LG1,yy,3.0D0*LG1,yy+3.0D0
    write(12,'(4(e15.7))') 4.0D0*LG1+1.0D0*LG2,yy,4.0D0*LG1+1.0D0*LG2,yy+3.0D0
    xx=0.0D0
    write(12,'(4(e15.7))') xx,-ww-wu,xx-3.0D0,-ww-wu
    write(12,'(4(e15.7))') xx,-ww   ,xx-3.0D0,-ww
    write(12,'(4(e15.7))') xx,0.0D0 ,xx-3.0D0,0.0D0
    write(12,'(4(e15.7))') xx,ww    ,xx-3.0D0,ww
    write(12,'(4(e15.7))') xx,ww+wd ,xx-3.0D0,ww+wd
    close(12)

    fnameW='_P_text1.txt'
    open(12, file=fnameW, status='replace')
    ! text
    xx=0.5D0*LG1
    yy=ww+wd+5.0D0
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',LG1
    xx=1.0D0*LG1+0.5D0*LG1
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',LG1
    xx=2.0D0*LG1+0.5D0*LG1
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',LG1
    xx=3.0D0*LG1+0.5D0*LG1
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',LG1
    xx=4.0D0*LG1+0.5D0*LG2
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',LG2
    xx=4.0D0*LG1+1.0D0*LG2+0.5D0*LG2
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',LG2
    yy=ww+wd+9.0D0
    xx=1.0D0*LG1
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',2.0D0*LG1
    xx=3.0D0*LG1
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',2.0D0*LG1
    xx=4.0D0*LG1+1.0D0*LG2
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,0,0,'BC',2.0D0*LG2
    xx=-3.0D0
    yy=-ww-0.5*wu
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,90,0,'BC',wu
    yy=-0.5*ww
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,90,0,'BC',ww
    yy=0.5*ww
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,90,0,'BC',ww
    yy=ww+0.5D0*wd
    write(12,'(2(e15.7),3(i3),a3,f8.3)') xx,yy,8,90,0,'BC',wd
    ! Diameter of penstock
    yy=-ww+4.0D0
    xx=LG1-OS_1; elstr='';write(elstr,'(f4.2)') PS_1; elstr='@~f@~'//trim(adjustl(elstr))
    write(12,'(2(e15.7),3(i3),a3,1x,a9)') xx,yy,8,0,0,'MC',trim(elstr)
    xx=3.0D0*LG1-OS_1; elstr='';write(elstr,'(f4.2)') PS_1; elstr='@~f@~'//trim(adjustl(elstr))
    write(12,'(2(e15.7),3(i3),a3,1x,a9)') xx,yy,8,0,0,'MC',trim(elstr)
    xx=4.0D0*LG1+LG2-OS_2; elstr='';write(elstr,'(f4.2)') PS_2; elstr='@~f@~'//trim(adjustl(elstr))
    write(12,'(2(e15.7),3(i3),a3,1x,a9)') xx,yy,8,0,0,'MC',trim(elstr)
    close(12)

    ! turbine drawing (broken line)
    dummy='P_tb1';call TURBINE(D1_1,OS_1,PS_1,-ww-wu-3.0D0,GW_1,dummy)
    dummy='P_tb2';call TURBINE(D1_2,OS_2,PS_2,-ww-wu-3.0D0,GW_2,dummy)

    fnameW='_P_tb.bat'
    open(12, file=fnameW, status='replace')
    elstr='';write(elstr,'(f4.1)') LG1
    do i=1,4
        write (dummy,'("_P_tb1_",i1.1,".txt")') i
        write(12,'(a)') 'gawk "{print $1+'//trim(adjustl(elstr)) &
        //',$2}" '//trim(adjustl(dummy)) //' | psxy -R -JX -W3t5_5:0 -O -K >> %fig%'
    end do
    elstr='';write(elstr,'(f4.1)') 3.0D0*LG1
    do i=1,4
        write (dummy,'("_P_tb1_",i1.1,".txt")') i
        write(12,'(a)') 'gawk "{print $1+'//trim(adjustl(elstr)) &
        //',$2}" '//trim(adjustl(dummy)) //' | psxy -R -JX -W3t5_5:0 -O -K >> %fig%'
    end do
    elstr='';write(elstr,'(f4.1)') 4.0D0*LG1+LG2
    do i=1,4
        write (dummy,'("_P_tb2_",i1.1,".txt")') i
        write(12,'(a)') 'gawk "{print $1+'//trim(adjustl(elstr)) &
        //',$2}" '//trim(adjustl(dummy)) //' | psxy -R -JX -W3t5_5:0 -O -K >> %fig%'
    end do
    close(12)

stop

contains

    subroutine TURBINE(D1,OS,PS,y0,GW,fn)
        real(8),intent(in)::D1,OS,PS,y0,GW
        character(len=50),intent(in)::fn
        real(8)::r1,r2,r,ang,xx,yy
        integer::i
        character(len=50)::fnameW
        real(8),parameter::theta=60.0D0/180.0D0*pi

        ! penstock and casing
        fnameW='_'//trim(adjustl(fn))//'_1.txt'
        open(12, file=fnameW, status='replace')
        xx=-(OS+0.5D0*PS)
        write(12,'(2(e15.7))') xx,y0
        r1=PS*1.0D0+(OS-0.5D0*PS)
        r2=PS*0.9D0+(OS-0.5D0*PS)
        do i=0,90
            ang=dble(i)/180.0D0*pi
            r=r1-(r1-r2)/90.0D0*dble(i)
            xx=-r*cos(ang)
            yy=r*sin(ang)
            write(12,'(2(e15.7))') xx,yy
        end do
        r1=PS*0.9D0+(OS-0.5D0*PS)
        r2=PS*0.7D0+(OS-0.5D0*PS)
        do i=1,90
            ang=dble(i)/180.0D0*pi
            r=r1-(r1-r2)/90.0D0*dble(i)
            xx=r*sin(ang)
            yy=r*cos(ang)
            write(12,'(2(e15.7))') xx,yy
        end do
        r1=PS*0.7D0+(OS-0.5D0*PS)
        r2=PS*0.5D0+(OS-0.5D0*PS)
        do i=1,90
            ang=dble(i)/180.0D0*pi
            r=r1-(r1-r2)/90.0D0*dble(i)
            xx=r*cos(ang)
            yy=-r*sin(ang)
            write(12,'(2(e15.7))') xx,yy
        end do
        r1=PS*0.5D0+(OS-0.5D0*PS)
        r2=PS*0.3D0+(OS-0.5D0*PS)
        do i=1,90
            ang=dble(i)/180.0D0*pi
            r=r1-(r1-r2)/90.0D0*dble(i)
            xx=-r*sin(ang)
            yy=-r*cos(ang)
            if(xx<=-(OS-0.5D0*PS))exit
            write(12,'(2(e15.7))') xx,yy
        end do
        xx=-(OS-0.5D0*PS)
        write(12,'(2(e15.7))') xx,yy
        write(12,'(2(e15.7))') xx,y0
        close(12)

        ! turbine
        fnameW='_'//trim(adjustl(fn))//'_2.txt'
        open(12, file=fnameW, status='replace')
        r=0.5D0*D1
        do i=0,360
            ang=dble(i)/180.0D0*pi
            xx=r*cos(ang)
            yy=r*sin(ang)
            write(12,'(2(e15.7))') xx,yy
        end do
        close(12)

        ! draft tube
        r=0.5D0*D1
        xx=-r*sin(theta)
        yy=-r*cos(theta)
        fnameW='_'//trim(adjustl(fn))//'_3.txt'
        open(12, file=fnameW, status='replace')
        write(12,'(2(e15.7))') xx,yy
        write(12,'(2(e15.7))') -0.5D0*GW,(0.5D0*GW-abs(xx))*tan(theta)-abs(yy)
        write(12,'(2(e15.7))') -0.5D0*GW,ww+wd+2.0D0
        close(12)
        fnameW='_'//trim(adjustl(fn))//'_4.txt'
        open(12, file=fnameW, status='replace')
        write(12,'(2(e15.7))') -xx,yy
        write(12,'(2(e15.7))') 0.5D0*GW,(0.5D0*GW-abs(xx))*tan(theta)-abs(yy)
        write(12,'(2(e15.7))') 0.5D0*GW,ww+wd+2.0D0
        close(12)

    end subroutine TURBINE

end program f90_PSP